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Figure 8 



File ga_omega.vbp 

Type=Exe 

Form= f rm„main . f rm 

Referenced \G{ 0002043 0-0000-0000-C000- 

000000000046}#2 . 0#0# . . \WINDOWS\SYSTEM\StdOle2 . tlb#OLE Automation 

Module=nmga ; nm_gal . bas 

Class=token_group; token_group . els 

Form-f rm_tokens . f rm 

F o rm= f rm_new_gr oup . f rm 

Form=f rm_edit__token. f rm 

Form=f rm_options . f rm 

Object={B02F3647-766B-llCE-AF28-C3A2FBE76A13}#2.5#0; SS32X25.0CX 
Objects 02B5E320-7292-llCF-93D5-0020AF99504A}#1.0#0; MSCHART.OCX 
Object=|BDC217C8-ED16-llCD-956C-0000C04E4C0A}#l.l#0; TABCTL32 .OCX 
Objects 6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0; COMCTL3 2 . OCX 

Form=f rm„text . f rm 

Reference=*\G{0D452EEl-E08F-101A-852E- 
JSr . 02608C4DOBB4}#2.0#0#. . WINDOWS \SYSTEM\FM20 . DLL #Microso ft Forms 2.0 
"if Object Library 
iJ Form=f rm_graphics . f rm 

S M Object={827E9F53-96A4-llCF-823E-000021570103}#1.0#0; GRAPHS 3 2 . OCX 

; =l Form=frm__histo.frm 

v!l Form=frm_sort_results . frm 

?i Form=f rm_debug. frm 

a :i Object={F9043C8 8-F6F2-101A-A3C9-08002B2F49FB}#l.l#0; Comdlg32.ocx 
Object={D6EEA3C0-6216-llCF-BE62-0080C72EDD2D}#1.0#0; MARQUEE. OCX 
IconForra= " f rm_main" 
Startup = "Sub Main" 
^ HelpFile=" " 
" ,: * ExeName 32 = " NM_GA . exe " 
^ Command32=" " 
J " Name^'ntruga" 
J HelpContextID= " 0 " 
- CompatibleMode="0" 
MajorVer=l 
MinorVer=0 
RevisionVer=0 
AutoIncrementVer=0 
ServerSupportFiles=0 
VersionCompanyName="MGA Software" 
CompilationType=0 
Op t imi z a t i onType = 0 
FavorPentiumPro ( tm) =0 
CodeViewDebuglnf o=0 
NoAliasing=0 
Bounds Check= 0 
0 ver f 1 o wChe c k= 0 
FlPointCheck=0 
FDIVCheck=0 
UnroundedFP=0 
StartMode=0 
Unattended=0 
ThreadPerOb j ect=0 
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Public seed_type As String 
Public seed_value As Integer 
Public save_best As Boolean 



Sub Main() 

Dim this_file As Integer 

n_files = GetSetting(appname:=="NM_GA", sections" Startup", _ 

Keyi— "N", Defauit:=0) 
For this_file = 1 To njfiles 

start Jiles(this_file) = GetSetting(appname:= ,, NM_GA M , sections" Startup", 

Key:="File" & str(thisjile), Default^"") 
frm_main.files(this_file).Visible = True 
frm_main.files(this_file).Caption = start Jiles(this_file) 
Next thisjile 
home_directory = "c:\" 

frm_main.Show 
End Sub 

Sub set_options() 
With frm_options 
.tat_mutation_rate = mutation_rate 
.txt_cross_over_freq = crossover Jreq 
.txt_frame_shift_prob - rrame_shift_prob 
.txt_theta_crit = theta_crit 
.txt_omega_crit = omega_crit 
.txt_sigma_crit = sigma_crit 
.txt_cov_crit = cov_crit 
.txt_generations = generationjimit 
.txt_upper Jimit = upper Jitness Jimit 
.txt Jowerjimit = lower_fitness Jimit 
.txt_corr_crit - corr_crit 
.txt_succ_crit = success_crit 
If omega J>lock = False Then 
.chk_non_diag_omega = 0 
Else 

.chk_non_diag_omega = 1 
End If 

If save_control = False Then 
,chk_save_control = 0 
Else 

.chk_save_control = 1 
End If 

If save J>est = False Then 
.chk_save_best = 0 
Else 

xhk_save J>est = 1 
End If 

If save_output = False Then 
,.chk_save_output ~ 0 
Else 

,chk_save_output - 1 
End If 

Select Case seed Jype 
Case "clock" 
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.opt_rnd_clock = True 
.txt_rnd„seed.Enabled = False 
Case "user" 
.opt_rnd_user = True 
,txt_rnd_seed = seed_value 
.txt_rnd_seed.Enabled = True 
Case "default" 
,opt_rnd_default = True 
,txt_rnd_seed.Enabled = False 
End Select 

If calLmethod = Mil" Then .opt_dll = True 

If calLmethod = "exe" Then .opt_exe = True 

.txt„pop_size = pop_size 

If n_runs = 1 Then .opt_lrun = True 

If n_runs = 2 Then .opt_2runs = True 

If n_runs = 4 Then .opt_4runs - True 

End With 

End Sub 



Sub get_bin(ByVal injium As Integer, ByRef bin_str() As Boolean) 
Dim n_genes As Integer, remainder As Integer, i As Integer, base As Integer 
n„genes = UBound(bin_str) 
base = 2 

For i = 1 To n_genes 
remainder = in_num Mod base 
If remainder > 0 Then 
bin_str(n_genes - i + 1) = True 
Else 

bin_str(n_genes - i + 1) = False 
End If 

in_num = in_num - remainder 
base = base * 2 
Next i 

End Sub 



Sub grid_search() 
this_gen = 1 
this_run - 0 

Dim n_pop As Double, this_group As Integer, this_set As Integer 
E>im binaryO As Boolean, valuesO As Integer, max_values() As Integer 
Dim n_genes As Integer, this_gene As Integer, thisjnd As Integer 
Dim cur_gene As Integer 

n_genes = count_omega_genes() + count_non_omega_genes() 
n_pop = get_n_pop() 
If n_pop < 1000000 Then 
Dim n_str As String 

If MsgBox("There will be " & n_pop & " runs" & vbCrLf & _ 

"Do you want to continue?", vbOKCancel, "Full grid search") <> vbOK Then 
Exit Sub 
End If 
Else 

If n_pop > 1000000000 Then 
n_str = Format(n_pop, "Scientific") 
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Else 

n _str = Format(n_pop, "0,000,000,000") 
End If 

MsgBox ("There are " & n_str & " runs, cannot dimension genome this large, please use GA") 
Exit Sub 
End If 

' otherwise, continue 

ReDim values(l To n_genes, 1 To n_pop) 
ReDim binary (1 To n_genes) 
ReDim max_values(l To n__genes) 
ReDim fitness(l To n_pop) 

For this_gene = 1 To n_genes 

max_values(this_gene) = token_collection(this_gene).n_token_sets 
Next this_gene 

* first set up the first indiivdual, all 1 's 
For this_gene = 1 To n_genes 
values(this_gene, 1) = 1 
Next this_gene 
' next creat the population 

'then increment each succesive individual, if you exceed max_values } increment the next 
For this_ind = 2 To n_pop 

For this_gene = 1 To n_genes 
values(this_gene, thisjnd) = values(this_gene, this_ind - 1) 

Next this_gene 

values(n_genes, this_ind) = values(n_genes, this_ind) + 1 
' check to see if this is over max 
cur_gene - n„genes 

While values(cur_gene, thisjnd) > max_values(cur_gene) 
values(cur_gene, this_ind) = 1 

values(cur_gene - 1, this_ind) = values(cur_gene - 1, this_ind) + 1 
cur_gene = cur_gene - 1 
Wend 
Next this_ind 

gen_directory = home_directory & "\1 M 
Dim test As String 

test = Dir(gen_directory, vbDirectory) 
If test o n V Then 
MkDir (gen_directory) 
End If 

ChDir (home_directory & M \l") 
* scaled fitness is dummy 
Dim scaled„fitness() As Single 
ReDim scaled_fitness(l To n_pop) 
y and run population 

run_population scaled_fitness(), values(), False 
End Sub 

Sub ga_runner(start_new_run As Boolean, check_out As Boolean) 
Dim scaled_fitness() As Single 

Dim n_pop As Double, this_group As Integer, this_set As Integer 
Dim genes() As Integer, max_values() As Integer 
Dim unmapped_values() As Integer, total_bits As Long 
Dim n_bits() As Integer ' number of bits in each gene 
Dim total_bit As Integer, this_bit As Integer 

Dim n_omega_genes As Integer, this_gene As Integer, this_ind As Integer 
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Dim cur_gene As Integer 

Dim n_rows As Integer, max_x As Single 

* set random seed if needed 

If seed_type = "clock" Then Randomize 

If seed_type = "user" Then Randomize (seed_value) 

' need to add genes for non-diagonal omega 
n_rion_omega_genes = count_non_omega_genes() 
n_omega_genes = count_omega_genes() 
n_genes = n_non_omega_genes + n_omega_genes 
' n„pop is either the maximum number or the number selected 
' we need to distiguish between genes (on genes) and bits (on genome). 
' a gene is represented by one or more bits 
' n_„pop is the population size, first well see ho 
n_pop = get__n_pop() 
If n_pop > pop_size Then 
n _pop = pop_size 
Else 

MsgBox ("Only " & n_pop & " combinations exist, will do grid search") 
grid_search 
Exit Sub 
End If 

* unmapped values are the "raw" values straight from the genome 

* which is basically randomly generated 

' you unmap them to get the "genes", which is used to create the control file. 
ReDim unmapped_values(l To n__genes, 1 To n_pop) 
ReDim genes(l To n__genes, 1 To n_pop) 

ReDim n_bits(l To n_genes) ' how many bits in each gene , only 1 if there are 2 possibilities, 2 if 3 or 4 etc 
ReDim fitness(l To n_pop) 
ReDim scaled_fitness(l To n_pop) 
ReDim max_values(l To n_genes) 
ReDim fitness(l To n_pop) 

ReDim unique_fit(l To n_pop * generation Jimit, 1 To 7) 

* genome_.integer, fitness,generation,indivdual, obj, success, covar, 

* need success and covar to put into the table. Scaled fitness will be added later, 

* from a new calculation. 

' find the maximum values that the gene can have, min value =1? 
non_omega_bits = count_non_omega_bits 
omega„bits = count_omega_bits 
total_bits = non_omega_bits + omega_bits 

For this__gene = 1 To n_non_omega_genes ' do not include omega genes 

max„values(this_gene) = token_collection(this_gene).n_token„sets 

n_bits(this„gene) = get_nbits(max_values(this_gene)) 
Next this_gene 

' next genes are block genes for omega, each is only 1 bit 

For this_gene = n„non_omega_genes + 1 To n_non_omega_genes + n_omega - 1 

max_values(this_gene) = 2 

n_bits(this_gene) = 1 
Next this_gene 

* final genes are sequence genes for omega 

Dim this_omega As Integer: this„omega = n_omega 

For this_gene = n_non_omega_genes + n_omega To n_genes 'do not include omega genes 
max_values(this_gene) = this_omega 
this_omega = this_omega - 1 

n_bits(this_.gene) = get_nbits(max_values(this„gene)) 
Next this_gene 
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' now that we know how many bits, we can define the size of the genome (a binary) 
'if genomoe is not yet defined 
frm_main.pgb_gen.max - generationjimit 

frm_main.pgb_gen.min = 0 
If si:art_new_run = True Then 

ReDim genome(l To total_bits, 1 To n_pop) 

' next creat the population 

' then increment each succesive individual, if you exceed max_values, increment the next 
For thisjnd = 1 To n_pop 

For this_bit = 1 To total_bits 
genome(this_bit, this_ind) = (Rnd() > 0.5) 

Next this_bit 
Next this_ind 

frm_main.pgb_gen. value = 0 
Else * continue old run, first check to see if old genome is the right size 
this_gen = last_gen 

If UBound(genome, 1) o total_bits Or UBound(genome, 2) o n_pop Then 
MsgBox "Error in genome, starting new GA run" 

ReDim genome(l To totaljrits, 1 To n_pop) 

' create the population anyway, canlt use old genome 

' then increment each succesive individual, if you exceed max_values, increment the next 
For this_ind = 1 To n_pop 

For this_bit = 1 To total_bits 
genome(this _bit, this_ind) = (Rnd() > 0.5) 

Next this_bit 
Next this_ind 

frm_main.pgb_gen.value - this_gen 
End If 

End If 

ReDim min_fitness(l To generationjimit) 
ReDim mean_fitness(l To generationjimit) 
ReDim max_fitness(l To generationjimit) 
n_rows = generationjimit 
max_x = generationjimit 

If start_new_run = True Then initialize_plot n_rows 
While this_gen < generationjimit And stop_run = False 

this_gen = this_gen + 1 

frm_main.pgb_gen. value = this_gen 

Dim ok As String 

gen_directory = home_directory & "\" & this_gen 
ok = Dir(gen_directory» vbDirectory) 
If Trim(ok) = Trim(str(this_gen)) Then 

ok= Dir(gen_directory & "Ncontrol", vbNormal) 

If ok o Then Kill gen_directory & "\*.*" 
Else 

MkDir gen_directory 
ChDir gen_directory 
End If 

' uncode genome, write to unmapped values 
uncode unmapped_values(), n_bits() 
' then unmap 

unmap genes(), max_values(), unmapped_values(), n_bits() 

run_population scaled_fitness, genes, check_out 

last_gen = this_gen 
1 Dim test_str As String, i As Integer 
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1 test_str = "before: " 

' For i = 1 To UBound(genome, 1) 

* If genome(i, 1 ) = True Then 
9 test_str = test_str & 1 

' Else 

test_str = test_str & 0 

* End If 
' Next i 

get_next_gen scaledJFitness ' only need genome, then goes back to uncode and unmap 
' test_str = test_str & vbCrLf & "after: " 
' For i = 1 To UBound(genome, 1) 
' If genome(i, 1) = True Then 

* test_str - test_str & 1 
' Else 

' test_str ~ test_str & 0 
' End If 
' Next i 

' MsgBox test_str, , "after" 

save_model "temp" & this.run & ".mdl" * save a temp copy after every new genome defined 
Wend 

' ftm_main.Show 1, frm_main 
End Sub 

Private Sub get_next_gen(scaled_fitness) 

Dim n_genes As Integer, this_ind As Integer, i As Integer 

Dim cum_fitness() As Single ' cummulative fitness, sum = 1 

Dim pairsO As Integer 

Dim n_pop As Integer 

n_genes = UBound(genome, 1) 

n„pop = UBound(scaled„fitness) 

ReDim cum_fitness(l To n_pop) 

Dim new_genome() As Boolean 

"ReDim new_genome(l To n_genes, 1 To n_pop) 

ReDim pairs(l To 2, 1 To n_pop / 2) 

If save_best = True Then 

Dim saved_genome() As Boolean: ReDim saved_genome(l To n_genes) 
Dim max_fitness As Single, best_one As Integer 
max_fitness = -9999999 
For i = 1 To n_pop 
If scaled_fitness(i) > maxjltness Then 
max_fitness = scaled_fitness(i) 
best_one = i 
End If 
Next i 

For i = 1 To n_genes 

saved_genome(i) = genome(i, best_one) 
Next i 
End If 

* calculate cumulative fitness, scaled to 1 . 
cum_fitness(l) = scaled__fitness( 1 ) 
For i = 2 To n„pop 

cum_fitness(i) = cum_fitness(i - 1) + scaled„fitness(i) 
Next i 

' and divide all by the sum 
For i = 1 To n„pop 
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cum_fitness(i) = curn_fitness(i) / cum_fitness(n_pop) 
Next i 

select_pairs pairs, cum_fitness 
' cross them over 
cross_over_genes pairs 
' and mutate 
mutate„genes 
firame_shift_genes 
' and if we Ye saving the best 
If save_best = True Then 

For i = 1 To n„genes 
genome(i, n_pop) = saved_genome(i) 

Next i 
End If 
End Sub 

Private Sub frame_shift_genes() 

* select which genes to frame shift 

' for these randomly select two points, 

* in the first place 

Dim this_gene As Integer, this_ind As Integer 
Dim start As Integer, last As Integer 
Dim rand As Single 

For this_ind = 1 To UBound(genome, 2) 
rand = Rnd() 

If rand < frame_shift_prob Then 
start = Rnd() * UBound(genome, 1) + 1 
last = Rnd() * UBound(genome, 1) + 1 
If last > start Then 

If last >= UBound(genome, 1) Then last = UBound(genome, 1) - 1 
If start <= 1 Then start = 1 

For this_gene = start To last - 1 

genome(this_gene + 1, this_ind) = genome(this_gene, thisjnd) 
Next this__gene 

genome(last, this_ind) = genome(start, this_ind) 
End If 

If start > last Then 

* last cant be 1 or you try to write to position 0 
If last <= 1 Then last = 2 

If start >= UBound(genome, 1) Then start = UBound(genome, 1) 
For this_gene = start To last Step -1 
genome(this_gene - 1, this_ind) = genome(this_gene, this_ind) 
Next this_gene 

genome(last, this_ind) = genome(start, this_ind) 
End If 

End If * rand < frame_shift if 
Next this_ind 
End Sub 

Private Sub cross_over_genes(pairs() As Integer) 
1 create new genome 

* I here are n_pop/2 pairs, each pair results in 2 individuals in the new_genome 
Dim new_genome() As Boolean 

Dim this_pair As Integer, n_pairs As Integer, length As Integer 
Dim this_gene As Integer ' 
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' genome is (gene,sub) 

'pairs is (1 to 2,nsub/2) 

n„pairs = UBound(pairs, 2) 

length = UBound(genome, 1) 

ReDim new_genome(Iength, n_pairs * 2) 

Dim where As Integer, rand As Single 

For this„pair = 1 To n_pairs 

' new individuals are (this_pair-l)*2 +1 and this_pair *2 in new_genome 
If Rnd() < cross_over_freq Then 

where = Rnd() * length 

For this_gene = 1 To where 
J write the left half of the gene, up to where 

new_genome(this__gene, (this_pair- 1) * 2 + 1) = genome(this_gene, pairs(l, this_pair)) 
;new_genome(this_gene, this_pair * 2) = genome(this_gene, pairs(2, this_pair)) 
Next this_gene 

For this_gene = where + 1 To length 
new_genome(this_gene, (this_pair - 1) * 2 + 1) = genome(thts_gene, pairs(2, this_pair)) 
new__genome(this_gene, this_pair * 2) = genome(this_gene, pairs(l, this_pair)) 

Next this_gene 
Else 

' no cross over 

For this_gene = 1 To length 
new_genome(this_gene, (this_pair - 1) * 2 + I) = genome(this_gene, pairs(l, this_pair)) 
new_genome(this_gene, this_pair * 2) = genome(this_gene, pairs(2, this_pair)) 

Next this_gene 
End If 

Next this_pair 

' then copy new_genome to genome 
For this„gene = 1 To length 
For this_pair = 1 To n_pairs * 2 

genome(this„gene, this_pair) = new__genome(this_gene, this„pair) 

Next this_pair 
Next this_gene 
End Sub 

Private Sub mutate_genes() 
Dim n„genes As Integer, this__gene As Integer 
Dim n_pop As Integer, this Jnd As Integer 
Dim rand As Single 

n_.genes = UBound(genome, 1): n_pop = UBound(genome, 2) 
For this_gene = 1 To n_genes 
For this_ind = 1 To n_pop 
rand = Rnd() 

If rand < mutationjrate Then genome(this_gene, this Jnd) = Not (genome(this_gene, this_ind)) 

Next this Jnd 
Next this_gene 
End Sub 

Function get„nbits(number As Integer) As Integer 
If number = 0 Then 
get_nbits - 0 
Else 

get_nbits = Log(number) / Log(2) + 0.4999 
End If 

End Function 

Sub run_population(scaled Jitness() As Single, values() As Integer, check-out As Boolean) 
Dim limit_str As String ' is theta at the upper or lower limit 
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Dim genomejnteger As Double, old_fitness As Single 
Dim old_gen As Integer, oldjnd As Integer, old_dir As String 
Dim already_run As Boolean 
Dim fitness() As Single 

Dim n_ind As Integer, control_code As String, i As Integer, ok As String 

Dim n_genes As Integer, one_run_values() As Integer 

Dim obj As Single, success As Integer, covar As Integer 

n_ind = UBound( values, 2) 

ReDim fitness(n_ind) 

RelDim new_fitness(n_ind) 

n_genes = UBound( values, 1) 

ReDim one_run_values(l To n_genes) 

Dim this_runl As Integer 

this__run = 0 

frm_main.pgb_ind.max = njnd 

***************************************************************** 
***************** XOP OF POPULATION LOOP ************************ 
***************************************************************** 

For this_runl = 1 To n_ind ' this_runl = local this_run 
frm_main.pgb_ind. value - this_runl 
frm_main.Refresh 
DoEvents 

Do While paused = True 

DoEvents 

Sleep 500 

Loop 

this_run = this_run + 1 
frm_main.spr_result.col = 9 

frm_main.spr_result.ro w = (this_gen - 1) * n_ind + this_runl 
frm„main.spr_result. value = this„runl 
frm_main.spr_resultcol = 8 
frm_main.spr_result. value = this_gen 
DoEvents 

If stop_run = True Then Exit Sub 
For i = 1 To n„genes 

one_run_values(i) = values(i, this_runl) 
Nexti 

control_code = make_control(frm_main.txt_code, one_run_values(), token_collection()) 
ok = Dir(gen_directory & H \" & this_runl, vbDirectory) 
If Trim(ok) = Trim(str(this_runl)) Then 

ok == Dir(gen_directory & T & this_runl & "Ncontrol", vbDirectory) 

If oko w " Then Kill gen_directory & "V & this_runl & "\* *" 
Else 

MkDir gen_directory & 'Y & this_runl 
ChDir gen_directory & 1 Y & this_runl 
End If 

Open gen_directory & "\" & this_runl & "\eontror For Output As #1 
Print #1, controLcode 
Close #1 

* first check to see if this genome has been run 
already_run = False 

limit_str = ,,H * reset the string that describes whether theta is at the boundry to null 
genome__integer = make_int(this_runl) 
For i = 1 To n_unique 
If genome_integer = unique_fit(i, 1) Then 
fitness(this_runl) = unique_fit(i, 2) 
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old_gen = unique_fit(i, 3) 
old_ind = unique_fit(i, 4) 
obj = uniquejit(i, 5) 
success = unique_fit(i, 6) 
covar = unique_flt(i, 7) 
run_number = run_number + 1 
already_run = True 

* need to recalcuate limit_str for already run model NOT DONE YET 
Exit For 
End If 

Next i 

Sleep 100 'to clear file buffer before deleteing files. 
If already_run = False Then 

fitness(this_runl) = calLnm("c:'\ gen_directory & "\" & this_runl, "control", obj, success, covar, limit_str, 
check_out) 

On Error Resume Next ' don't ned to worry if you cant delete file 

If Dirffdata", vbNormal) o ,,H Then Kill ("fdata") 

If Dir("link.Ink\ vbNormal) o "" Then Kill ("lintlnk") 

If Dir("prderr'\ vbNormal) o "" Then Kill ("prderr") 

If Dir("freport\ vbNormal) o "" Then Kill ("freport") 

If Dirffsubs", vbNormal) o "" Then Kill ("fsubs") 

If Dir("fsubs.for", vbNormal) o "" Then Kill ("fsubs.for") 

If Dir("nonmem.exe", vbNormal) o "" Then Kill ("nonmem.exe") 

If Dir("df.txt", vbNormal) o Then Kill ("df.txt") 

On Error GoTo 0 

n__unique = n_unique + 1 

frm_main.lbl_count = n_unique 

umque„fit(n_unique, 1) = genome_integer: unique_fit(n_unique, 2) = fitness(this_runl) 
unique_fit(n_unique, 3) = this_gen: unique_fit(n_unique, 4) = this_runl 
unique_fit(n_unique, 5) = obj: unique_fit(n_unique, 6) = success 
unique_fit(n_unique, 7) = covar 

* need to write the results to the spreadsheet, usually done by call_nm 
Else 

okLdir = home.directory & "\" & Trim(str(old_gen)) & "\" & Trim(str(old_ind)) & "\" 

ChDir (gen_directory & T & this„runl) 

If LCase(Dir(old_dir & "control")) = "control" Then 

FileCopy old_dir & "control", CurDir & "\control" 

End If 

If LCase(Dir(old_dir & "result")) = "result" Then 
FileCopy old.dir & "result", CurDir & "\result" 
End If 

If LCase(Dir(old_dir & "output")) = "output" Then 
FileCopy old_dir & "result", CurDir & "\output" 
End If 

If LCase(Dir(old_dir & "inputs")) = "inputs" Then 
FileCopy old_dir & "inputs", CurDir & "\mputs 1 ' 
End If 

If LCase(Dir(old_dir & "parms")) = "parms" Then 
FileCopy old_dir & "parms", CurDir & "\parms" 
End If 
End If 

' and write the results 
With frm_main.spr_result 
.col = 2 

If success = 0 Then 
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.text = "Yes" 
Else 

.text = "No" 
End If 

.row = run_n umber 
.col = 3 

If success = 0 And covar = 0 Then 

.text = "Yes" 

Else 

.text = "No" 
End If 
.col ~ 4 

.text = fitness(this_runl) 
xol = 1 

Ifobj< 999999999.9 Then 

.text = obj 

Else 

.text = "Crash" 
xol = 2 
text = "No" 
.col = 3 
.text = "No" 
.col - 4 
.text = "Crash" 
End If 
xol =11 
.text = limit_str 
xol = 1 
.Action = 0 
End With 

DoBvents: frm__main.Refresh 

If save_control = False Then Kill "control" 

If save_output = False Then 

If Dir(\\output\ vbNormal) = "result" Then Kill "result" 
End If 

If stop_run = True Then Exit Sub 
Next this jrunl 

scale_fitness scaled_fitness(), fitness() 
' update plot 

update_plot fitness(), scaled_fitness() 
End Sub 

Sub update_plot(fitness() As Single, scaled_fitness() As Single) 
* first append new fitness values onto all_fitness 
' need to check to see if n generations is exceeded for time limited 
Dim i As Integer, n As Integer 

Dim this_min As Single, this_max As Single, this_mean As Single 

Dim sum As Single, count As Integer 

this_min = 999999999 

this_max-= -99999999 

sum = 0 

count - 0 

For i = 1 To UBound(fitness) 
If fitness(i) < 9999999 Then 
If fitness(i) < this„min Then this_min = fitness(i) 
If fitness(i) > this_max Then this_max = fitness(i) 
sum = sum + fitness(i) 
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count = count + 1 
End If 
Nexti 

If count oOThen 
this_mean = sum / count 
Else 

this_mean = 1000000 
End If 

With frm_main.MSChartl 
.row = this_gen 
.Column = 1 
.Data = this_min 
.Column = 2 
.Data - this_mean 
.Column = 3 
.Data = this_max 

.DrawMode = VtChDrawModeDraw 
End With 

With frm_main.spr_result 
.col = 10 

For i = 1 To pop_size 
.row = (this_gen - 1) * pop_size + i 
.text = Format(scaled_fitness(i), "0.000") 
Next i 



End With 
End Sub 

Sub initialize_plot(n_rows As Integer) 

Dim i As Integer, n As Integer 

' final 2 columns define upper limit of axis 

With frm_main.MSChartl 

.RowCount = 0 

.ColumnCount = 0 

.RowCount = n„rows 

.ColumnCount = 3 

For i = 1 To n_rows 

.row = i 

.RowLabel = i 
Nexti 

.DrawMode = VtChDrawModeDraw 
End With 
End Sub 

Function get_n_pop() As Double 

Dim this_group As Integer, n_sets As Double 

n„sets = 1 

For this_group = 1 To n_token_groups 

n .sets = n_sets * token_collection(this_group).n__token_sets 

Next this_group 

get_n_pop = n_sets 

End Function 

Function make_control(ga_code As String, values() As Integer, _ 

token_collection() As token„group) As String 
' so, search ga_code for each instance of stem( 1 ) to stem(n_token_groups) 

•1 betas will be "{THETA(a)}" in the $PK, ERROR or pred and (, {$THETA(A) =} (0,1,2) for the theta 
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' part, similarly for omega and sigma 

'afterward, well need to sort out A, B etc and put the $THETA, $OMEGA and $SIMGA 
1 element in proper order 

' and mover the { $THETA( A)= } TO AFTER THE VALUES 
Dim done As Boolean, this_int As Integer 
If this_run> 15 Then 
MsgBox "Pause" 
End If 

Dim this_token_set As Integer 
Dim this_token As Integer 

Dim new_code As String, new_string As String, old_string As String 
new_code = ga_code 
Dim test_string As String 
done = False 

While Not (done) * loop here until no more token_stem(*) is found 

' this will loop trough the non-omega genes 

For this_token_set = 1 To n_token_groups 
For this_token = 1 To token_collection(this_token_set).n_tokens 
old_string = token_collection(this_token_set).stem & "(" & this_token & ")" 
new_string = token_collection(this_token_set).get_token(values(this_token_set), this_token) 
new_code = sub_string(new_code, old_string, new_string) 

* frm_texttxt„text = new_code 
' frmJextShow 1, frm_main 

Next this_token 
Next this_token_set 
' check to see if we are done 
' loop over token_set stem to look for more tokens 
' look for token_set.stem & (1-9) 
done = True 

For this_token„set = 1 To n_token_groups 
For this_int = 1 To max_theta 

test_string = token_col!ection(this_token_set).stem & "(" & Trim(str(this_int)) & ")" 
' if test_string is in code, then not done 
frm_texttxt_text = new_code 
' frm_text.Show 1, frm_main 

If InStr(l, new_code, test_string, vbTextCompare) o 0 Then 
done — False 
Exit For 
End If 
Next this __int 

If done = False Then Exit For 
Next this_token_set 
Wend ' end of loop over 

* now the final editting, replace the {crlf } with real crlf 

new_code = add_crlf(new_code) 
If MsgBox(new_code, vbOKCancel, "before match_reference") = vbCancel Then End 
' match up the THETA(A) with correct THETA(l)'s 
new_code = match_references(new_code) 
* sort the resulting theta^etas, sigmas 
new_code = sorter(new_code) 

* finally, swap $THETA= to end of line 

new_code = swapper(new_code) 
If MsgBox(new_code, vbOKCancel, "final") = vbCancel Then End 

' now, if omega_block is true, first remove the all omega parts and substitute the omega BLOCK(n) parts 
If omega_block = True Then 
' sustitute the BLOCK syngtax 
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Trm_text.txt_text = new_code 
'frm._text.Show 1, fmwnain 
ncw_code - sub_omega_block(new_code, values) 
End If 

make_control = new_code 
*MsgBox new_code 
End Function 

Function sub_omega_biock(code As String, values() As Integer) As String 

Dim block_part As String, n_etas As Integer 

Dim omega_start As Integer, n As Integer 

Dim omega_end As Integer, this_gene As Integer 

Dim start_pos As Integer, end_pos As Integer 

Dim init_omega() As Single: ReDim init_omega(l To n„omega) 

Dim sequences() As Integer: ReDim sequences(l To n_omega - 1) ' sequence of omegas, all possible etas 
(ie max omega, n_omega) 

Dim new_sequences() As Integer ' the sequences specefic for this control 

' sequence will have max_omega values 
Dim left__part_code As String, right_part_code As String ' left and right parts of code, without the omega 
block 

Dim covar_values() As Boolean: ReDim covar_values(l To n_omega - 1) 1 is this row in a block with the 
row above? does not include first row 

* read in covar_va!ues() go ahead an read in all , even though well only use some 
For this_gene = 1 To n_omega - 1 

If values(this_gene + n_non_omega_genes) = 2 Then 

covar_values(this_gene) = True 

End If 
Next this_gene 

' while weTre here, read in sequences 
For this_gene = 1 To n_omega - 1 

sequences(this_gene) = values(this_gene + n_non_omega_genes + n_omega - 1) 

' while weVe here, read in sequences 
Next this_gene 

Veil need to compress the sequence of the first n sequence values into 1 to n 

*e.g. if we have 4 etas in this control, but max_omega = 7, and sequence is 5,6,3,1,24 

* we compress the first 4 into 3,4,2,1 

' so we need to figure out how many etas in this control file. 
n„etas = count_etan(code) 
^Erm_text.txtjext = code 
jfrm_text.Show 1, frm_main 

* first cut out the omega block 
omega_start = InStr(l, code, "$OMEGA") 
omega_end = InStr(l, code, "$SIGMA") - 1 
left_part_code = Left(code, omega_start - 1) 
*frm_texttxt_text = left_part_code 
, ftm_text.Show 1, frm_main 

right_part_code = Right(code, Len(code) - omega_end) 
'frm_text.txt_text = right_part_code 
'frm_text.Show 1, frm_main 

block_part = Mid(code, omega_start, omega_end - omega_start) 
*frm„text.txt_text = block_part 
Trm_text.Show 1, frm_main 

* remove $OMEGA 

block„part = Right(block_part, Len(block„part) - 7) '7 for the $OMEGA 
Trm_text.txt_text = block„part 
frm_text.Show 1, frm_main 
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* remove all parts between ; and vbcrlf 

While InStr(l, block_part, ";") <> 0 

' If this_run = 4 Then 

' frm_text.txt_text = block_part 

' frm_text.Show 1, frm_main 

' End If 

start_pos = InStr(l, block_part } ";") - 1 

* find end of line 

end_pos = InStr(start_pos, block_part, vbCrLf) 
If end_pos = 0 Then end_pos - Len(block_part) 
'MsgBox Left(block_part, start_pos) 

bIock_part = Left(block_part, start_pos) & Right(block_part, Len(bIock_part) - end_pos) 
MsgBox bIock_part 
Wend 

block_part = Trim(block„part) 
' now get the values for omega' just read the (??) values 
' find pairs between ( and ) and read into init_omega 
start_pos= 1: n= 1 

While InStr(start_pos, block_part, "(") o 0 
start_pos = InStr(start_pos, bIock_part, "(") + 1 
end_pos = InStr(start_pos, block_part, ")") 

init_omega(n) = Val(Mid(block_part, start_pos, end_pos - start_pos)) 

n = n+ 1 

Wend 
' and resequence them 

' if there are no etas exit, will cause a crash in nonmem, but that's ok 

If n_etas > 0 Then 

ReDim new_sequences(l To n_etas) 

Else 

sub_omega_block = code 
Exit Function 
End If 

' read in the new sequences from the sequenes 

* loop over sequences, looking for values 1 to n_etas. 

* note that sequences has n_omega -1 elements, the final 
'position is determined by the others 

Dim cur_eta_count As Integer ' count of non-zero elements 
Dim n_etas Jeft As Integer • how many etas are left to fill 

Dim i As Integer, cur_eta_position ' current position in new_sequences being examined (to see if = 0) 
n_etas Jeft = n_etas 

For i = 1 To n„ctas ' looking for ETA(i) in main code 
' get the values from sequences 
cur_eta_position = sequences(i) 

If cur_eta_position > n_etas_left Then cur_eta_position = n_etas Jeft 
cur_eta_count = 0 
For n = 1 To n_etas 

If new_sequences(n) - 0 Then cur_eta_count = cur_eta_count + 1 
If cur_eta_count = cur_eta_position Then 
new_sequences(n) = i 
n_etas_left = n_etas Jeft - 1 
Exit For 
End If 
Next n 
Next i 

' substitute the etas 

' first change THETA to XXXXX 
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1 frm_text.txt_text = code 
'frrnJext.Show i, frm_main 

Ieft_part__code = sub_string(left_part„code, "THETA", "XXXXX") 

Dim new_string As String, okLstring As String ' new string will be " YYY(" to prevent re- replacement 
For i = 1 To n_etas 

old_string = H ETA(" & Trim(str(i)) & ")" 
new_string = "YYY(" & Trim(new_sequences(i)) & ")" 
Ieft_part_code = sub_string(left_part_code, old_string, new_string) 
Nexti 

"and replace the M YYY( M with "ETAC 

]eft_part_code = sub_string(left_part_code, M YYY(", "ETA(") 

left_part_code = sub_string(Ieft_part_code, "XXXXX", "THETA") 
T frm_texttxt_text = left_part_code 
1 frm_text.Show 1, frm_main 
1 and write the new block 
1 build new omega block 

Dim new_omega_block As String, this_column As Integer 
Dim this_row As Integer, cur_end_row As Integer 
Dim cur_row_count ' how many rows in this block 
Dim off_diag As String 

this_column = 1: this_row = 1 
cur__end_row = 1 
While cur_end_row <= n_etas 

' is this a new block, if so how big? 

' loop through covar_values until you find a false 

cur_row_count = 1 

*************************************** 

m:***********^^ t0 p Ut j nt0 0 i£ project 

***************************************** 

Do While covar_values(cur_end_row) And cur_end_row < n_etas 

cur_row_count = cur_row_count + 1 

cur_end„row = cur_end„row + 1 

If cur_end_row > n„etas Then Exit Do 
Loop 

' need to see if we have exceeded the number of etas 
If cur_end_row > n_etas Then cur_end_row = n_etas 
If curjrow_count = 1 Then 

new_omega_block = new„omega_block & M $OMEGA H & vbCrLf 

Else 

new_omega_block = new_omega_block & "$OMEGA BLOCK(" & Trim(str(cur_row_count)) & & 
vbCrLf 
End If 

For i = 1 To cur_row_count 
'construct off diagonal elements 
ofLdiag = '* " 
For n = 1 To i - 1 
off_diag = off_diag & M (0.00001) M 
Next n 

new_omega_block = new_omega_block & off_diag & "(" & init_omega( 1 ) & "Y& vbCrLf 
Nexti 

* MsgBox new_omega_biock 

cur_end_row = cur_end_row + 1 
Wend 'this_row 

sub_omega_block - left_part_code & new_omega_bIock & right_part_code 
*frm_text.txt_text = left„part_code & vbCrLf & new_omega_block & vbCrLf & right_part_code 
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Trm_text.Show 1 , frm__main 
End Function 

' and sequence the etas 

Function sequence_omegas(code As String) 

sequence_omegas = code 

Esnd Function 
Function sorter(ByVal code As String) As String 
' this function sorts the theta,omegas and sigma initial estimates 
Dim new__code As String, cut_out As String, this_prefix As Integer 
Dim stack(l To max_theta) As String, stack_order(l To max_theta) As Integer 
Dim new_cut_out As String, token As String 

Dim first_position As Long, last_position As Long, next_position As Long 

Dim cur_prefix As String, position As Long 

Dim prefixes(l To 3) As String, stack_position As Integer 

prefixes(l) = "{$THETA(": prefixes(2) = "{$ETA(": prefixes(3) = ,, {$EPS( ,, 

If MsgBox(code, vbOKCancel, "in sorter") = vbCancel Then End 

Dim old_cut_out As String ' need to preservie original cut out to use in substring 

new_code - code 

For this_prefix = 1 To 3 

If MsgBox(code, vbOKCancel) = vbCancel Then End 

If InStr(new_code, prefixes(this_prefix)) = 0 Then Exit For 

MsgBox new_code 

'collect all {THETA(?)=} (XXX)} 

'find the first {THETA 

first_position = InStr(l, new_code, prefixes(this_prefix)) 
last_position = first_position 
' then find end of theta section 

next_position = InStr(last_position + 1, new_code, prefixes(this_prefix)) 
While next_position o 0 

next_position = InStr(last_position + 1, new_code, prefixes(this_prefix)) 

If next_position o 0 Then last_position = next_position 
Wend 

1 then find the end of the last theta string 

' note that you must end with a ")" 

* find the first " } " at the end of the string 

lastjosition = InStr(last_position, new_code, M }") 

'then the final ")" 

last_position = InStr(last_position - 1, new_code, ")") + 1 
' cut out that section and sort it 
MsgBox new_code 

cut_out = Mid(new_code, first_position, last_position - first_position) 

c»ld_cut_out = cut_out 'need to save old cut_out for substring, since we are about 

*to change cut_out 

' remove all vbcrlf from cut_out 

cut_out = sub_string(cut_out, vbCrLf, "") 

MsgBox cut_out 

'assemble the stack of values 

' find the lowest value, put it in stack(l) etc, 

Dim i As Integer, cur_start As String, n As Integer, token 1 As String, token2 As String, token3 As String 
For i = 1 To max_theta 
cur_start = prefixes(this_prefix) & i & ,, )=} ,i 
first_position = InStr(l, cut_out, cur_start) 

' seperate each token (from $theta to before next $theta) and put then on a stack to be sorted. 
If first_position <> 0 Then 
stack_position = stack_position + 1 ' next stack position 
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1 find the start of the next token, or the end of cut_out string 

last„position = InStr(first_position + 5, cut_out, "{$") - 1 ' 

If Iast_position < 0 Then last_position = Len(cut_out) 

token = Mid(cut_out, first_position, last_position - firsLposition + 1) 

token 1 = Mid(cut_out, first_position + Len(cur„start), _ 

last_position - first_position - Len(cur_start)) 
' token2 = " ;" & Mid(cut_out, first_position, Len(cur_start)) 

stack(stack_position) = token 

stack_order(stack_position) = i 
End If 
Next i 

' put cut out back together 

new_cut_out = "" 

For i = 1 To stack_position 

new_cut_out = new_cut_out & stack(i) & vbCrLf & " " 
Next i 

new_code = sub_string(new_code, old_cut__out, new_cut_out) 
new_cut_out= 

'MsgBox Mid(new_code, 500, Len(new_code) - 500) 

stack_position = 0 
Next this_prefix 
sorter = new_code 
End Function 

Private Function swapper(code As String) As String 
'this function puts the {$THETA(?)} after the value 

Dim this_prefix As Integer, position As Integer, eol As Integer, stop_pos As Integer 

Dim cut„out As String, rest_str As String, new_str As String, first_part As String 

Dim prefixes(l To 3) As String: prefixes(l) = "{$THETA(": prefixes(2) = M {$ETA(": prefixes(3) 

H {$EPS(": 

For this_prefix = 1 To 3 

' loop over the text looking for prefix 

position s= InStr(l, code, prefixes(this_prefix)) 

While position o 0 

'now find end of line 

stop_pos = InStr(position, code, " }") 

eol = InStrCstopjos, code, vbCr) - 1 

cut_out = Mid(code, position, eol - position + 1) '+ 1) 

stop„pos = InStr(position, code, "}") 

rest_str = Trim(Mid(code, stop_pos + 1, eol - stop_pos)) 

fiirst_part = Trim(Mid(code, position, stop_pos - position)) 

Mid(first_part,l,2) = ";; M 

new_str = rest_str & first_part 

code = sub_string(code, cut__out, new_str) 

position = eol - 3 

position = InStr(l, code, prefixes(this_prefix)) 
Wend 

Next this_prefix 
swapper = code 
End Function 

Function match_references(By Val code As String) 

' match up {THETA(A) with {THETA(A) = }(xxxx) to figure out which theta (eta) this is 
'and ETA(A) with {ETA(A) =} XX 
' and also sigma 

Dim this_prefix As Integer, integer_used As Boolean 

Dim position As Long, cur_prefix As String, next_value As Integer 
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Dim curjetter As Integer, curjnteger As Integer, cur_string As String 
Dim cur_new_string As String, cur_old_string As String 
Dim vtheta_used As Boolean 

' first pass through the data to find out which theta, eta and eps is available 

* Do theta first note that ETA is substring of THETA 

'ETA is in THETA, so well first change "THETA" to "XXXXX", do eta then change back 
code = sub_string(code, "THETA", "XXXXX") 

* MsgBox (code) 

Dim prefixes(l To 3) As String: prefixes(l) = "ETA": prefixes(2) = "THETA": prefixes(3) = "EPS" 
For this_prefix = 1 To 3 

cur_prefix = prefixes(this_prefix) 

' find out if there are any fixed thetas (i.e., theta(l)) 
¥rm JexLtxt Jext = code 
*frm_text.Show 1, frm_main 

'MsgBox (code) 
cur_string = cur_prefix & "(1)" 
position = InStr(code, cur_string) 
curjnteger = 1 

' find first available theta value 
While position > 0 

cur_integer = curjnteger + 1 

cur_string = cur_prefix & "(" & curjnteger & ")" 

position = InStr(code, cur_string) 
Wend 

* assign lowest available number 
next_value = curjnteger 

s MAIN LOOP THROUGH CODE TO SUBSTITUTE THETA(3) FOR THETA(A) 
' now loop through each posible value to variable theta (theta(a) to theta(z) 
' NEED MORE LETTER THAN 26 
For curjetter = Asc("A") To Asc("Z") 
vtheta„used = False 

* get new theta string 

cur_new_j5tring = cur_prefix & "(" & curjnteger & ")" 

* get old variable theta string 

cur_old_string = "{" & cur_prefix & & Chr(curjetter) & ")}" 
position = InStr(l, code, cur_old_string) 
While position > 0 
vtheta_used = True 

code = sub_string(code, cur_old_string, cur_new„string) 

* MsgBox code 

position = InStr(l, code, cur_old_string) 
Wend 

* now do {theta(A)=} part 

' right now well just replace, will need to sort and put theta(l) part 
' at the end later. 

cur_new_string = "{$" & cur_prefix & "(" & curjnteger & ")=}" 
cur_old_string = "{$" & cur_prefix & "(" & Chr(curjetter) & ")=}" 
position = InStr(l, code, cur_old„string) - 
While position > 0 

code = sub_string(code, cur_old_string, cur_new_string) 

position = InStr(l, code, cur_old_string) 
Wend 

' we want to increment curjnteger only if variable theta is used 
If vtheta_used = True Then curjnteger = curjnteger + 1 
Next curjetter 
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NOW THETA(AA) TO THETA(AZ) 



For curjetter = AscfA") To Asc("Z") 
vtheta_used = False 
' get new theta string 

cur_new_string = cur_prefix & "(" & cur_integer & ")" 
1 get old variable theta string, WITH THE "A" 

cur_old_string = & cur_prefix & "(A" & Chr(curjetter) & ")}" 

position = InStr(l, code, cur_old_string) 

While position > 0 
vtheta_used = True 

code = sub_string(code, cur_oid_string, cur_new_string) 
' MsgBoxcode 

position = InStr(l, code, cur_old„string) 
Wend 

'now do {theta(AA)=} part 

* right now well just replace, will need to sort and put theta(l) part 
' at the end later. 

eur_new_string = "{$" & cur_prefix & "(" & curjnteger & ")=}" 
cur_oid_string = " {$" & cur_prefix & "(A" & Chr(cur Jetter) & ")=}" 
position = InStr(l, code, cur_old_string) 
While position > 0 

code = sub_string(code, cur_old_string, cur_new_string) 

position = InStr(l, code, cur_old_string) 
Wend 

' we want to increment curjnteger only if variable theta is used 
If vtheta_used = True Then curjnteger = curjnteger + 1 
Next curjetter 



'NEXT PREFIX 

• change XXXX back to THETA if we just did theta 

If this .prefix = 1 Then code = sub_string(code, "XXXXX", "THETA") 

Next this_prefix 

If MsgBox(code, vbOKCancel, "end of match_ref ') = vbCancel Then End 
match_references = code 
End Function 

Function add„crlf(ByVal code As String) As String 

'replace the {crlf} with vbcrlf 

Dim where As Long 

where = InStr(l, code, "{crlf}") 

While where > 0 

code = sub_string(code, "{crlf}", vbCrLf) 
where = InStr(l, code, "{crlf}") 
Wend 

add_crlf = code 
End Function 

Function sub_string(code As String, old_str As String, new_str As String) As String 
' first check to see if code has changed 
If InStr(new„str, old_str) > 0 Then 

sub_string = code 
Else 

' this function replaces all instances of old_str with new_str 

Dim position As Long, new_code As String, ieft_part As String, right_part As String 
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position = InStr(l, UCase(code), UCase(old_str)) - I 
new_code = code 
While position > 0 
left_part = Left(new_code, position) 

right_part = Right(new_code, Len(new_code) - position - Len(old_str» 

new_code = left_part & new_str & right_part 
position = InStr(position, new„code, old_str) - 1 
Wend 

MsgBox (sub_string) 
MsgBox (new_str) 
MsgBox (old„str) 
sub_string = new_code 
End If 

MsgBox (sub_string) 
End Function 



Function count_non_omega_genes() 
count_non_omega__genes = n_token_groups 
End Function 

Function count_omega_genes() 
If omega_block = True Then 
n_omega = count_max_omega 
count_omega_genes = 2 * (n_omega - 1) 

' n_omega genes for the sequence (n_omega-l)! and n_omega -1 for the block definition 
Else 

count_omega_genes - 0 
End If 

End Function 

Function count_non_omega_bits() 

Dim i As Integer 

Dim n As Integer 

For i = 1 To n_token_groups 

* one token set requires no genes, two requres 1, 3 or 4 requires 2, 5 to 8 requires 3 

• basically, ceiling(log base 2(n_token_sets) 

n = n + CInt(Log(token_coilection(i).n_token_sets) / Log(2) + 0.499999) 
Next i 

count_non_omega_bits = n 
End Function 

Function count_omega_bits() 

Dim i As Integer 

Dim n As Integer 

If omega_block = True Then 

n = n_omega - 1 'for the block part, one bit per gene (is this in a block with the row above?) 
' sequence part (n-1)! 
For i - n_omega To 2 Step -1 

'eta(l) can be in n_omega possible values, eta(2) can be in n_omega -1 etc, 
* to eta(n_omega) which is fixed 
n - n + CInt(Log(i) / Log(2) + 0.499999) 
Next i 

count_omega„bks = n 
Else 

count_omega_bits = 0 
End If 

End Function 
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Sub randomizer(ByRef genome() As Boolean) 

Dim i As Integer, n As Integer 

Randomize 

For n = 1 To pop_size 

For i = 1 To UBound(genome, 2) 
genome(n, i) = CInt(Rnd()) 

Next i 
Next n 
End Sub 



Public Sub save_model(file„name As String) 
' get file name 

* need to save: 
' control file 

' genome 

* token set 
' options 

'first, control file 
n_ models = 1 

Dim i As Integer, n As Integer, p As Integer 
file_name = home_directory & "\" & file_name 
Open file_name For Output As #1 
Print #1, "Number of models = " & vbCrLf & njnodels 
For i = 1 To njnodels 

Print #1, "########### Begining of model # " & i & " //////////////////////// " 
Print #1, frm_main.txt_code 

Print #1, "########### End of model # " & i & " UIUWUUUUUUUMMM " 
Next i 

Print #1, "### End of GA code ###" 
Piint #1, " Last gen", vbCrLf, last_gen 
Print #1, "### Start of genome ###" 
Dim gen_str As String 
If run_number = 0 Then 
Print #1, "Genome not defined" 
Else 

Dim n_bits As Integer 

n„bits = count_omega_bits() + count_non_omega_bits() 
Print #1, M N bits = ", vbCrLf, UBound(genome, 1) 
Print #1, "Pop size = ", vbCrLf, UBound(genome, 2) 
' genome is n_bits by pop size 
For i = 1 To UBound(genome, 1) 
For n = 1 To UBound(genome, 2) 

gen_str = gen_str & " " & -Int(genome(i, n)) ' - because fals = 0, true 
Next n 
Print #1, gen_str 
gen_str = "" 
Next i 
End If 

Print #1, "### End of genome ###" 
Print #1, "### Begining of tokens ###" 
For i = 1 To n_token_groups 

Print #1 , "Group stem = \ vbCrLf, token_collection(i).stem 

Print #1, "N token sets = vbCrLf, token_collection(i).n_token_sets 

Print #1, "N tokens = H , vbCrLf, token_col lectio n(i).n_tokens 
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For n = 1 To token„collection(i).n_token_sets 
Print #1 , "Token set # *\ vbCrLf, n 

For p = 1 To token_collection(i).n_tokens 

Print #1, token_collection(i).get_token(n, p) 

Next p 
Next n 
Next i 

Print #1, '*### End of tokens ###" 

Print #1, "### Begining of options ###" 

Print #1, "cross_over_freq", vbCrLf, cross_over_freq 

Print #1, "mutation_rate", vbCrLf, mutation_rate 

Print #1, "frame shift prob", vbCrLf, frame_shift_prob 

Print #1, "n_runs M , vbCrLf, n_runs 

Print #1, "theta_crit\ vbCrLf, theta_crit 

Print #1, "omega_crit", vbCrLf, omega_crit 

Print #1, "sigma_crit", vbCrLf, sigma_crit 

Print #1, "cov_crit", vbCrLf, cov_crit 

Print #1, "pop_size'\ vbCrLf, pop_size 

Print #1, "generation_limit'\ vbCrLf, generationjimit 

Print #1, "calLmethod", vbCrLf, call_method 

Print #1, "upper fitness limit", vbCrLf, upper jBtnessJimit 

Print #1, "lower Jitnessjimit", vbCrLf, lower_fitness_limit 

Print #1, "correlation criteria", vbCrLf, corr_crit 

Print #1, "success_criteria", vbCrLf, success_crit 

Print #1, "save control", vbCrLf, save_controI 

Print #1, "save best", vbCrLf, save_best 

Print #1, "save output", vbCrLf, save_output 

Print #1, "omega block", vbCrLf, omega_block 

Print #1, "seed type", vbCrLf, seed_type 

Print #1, "seed value", vbCrLf, seed_value 

Print #1, "### End of options ###" 

Print #1, " IlltlllllllUllltllUUIIllItlUllilllllltir 

Close #1 

End Sub 

Sub get_model(file As String) 

Dim textline As String, code As String, n As Integer, njuts As 
Dim n_token_sets As Integer 

Dim i As Integer, token_set_num As Integer, token_num As Inl 
For i = 1 To n_token_groups 
token_collection(i)xlear 
Next i 

n_token_groups = 0 
IfDir(file) = ""Then 

MsgBox ("File not found") 

Exit Sub 
End If 

* ' see if it is on the start_files 
' For i = 1 To n_files 

' If startjiles(i) = file Then 
For n = i To n_files - 1 

start_files(i) = start_fiies(i + 1) 

frm„main.files(i).Caption = start_files(i) 
Next n 

* start_files(n_files) = 
frm_main.files(n_files). Visible = False 
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* n_files ~ n_files - 1 
' End If 

' Nexti 

^* ********* ************* 



For i = 1 To n_files 
If start_files(i) = file Then 
1 remove it 

For n = i To n_files - 1 Step 1 

start_files(n) = start_files(n + 1) 
Next n 
n._files = n_files - 1 
start_files(n_files + 1) = "" 
Exit For 
End If 
Next i 

If n_files < 4 Then n_files = n_files + I 
Fori = nfilesTo2Step-l 
start_files(i) = start_files(i - 1) 
frm„main.files(i).Caption = start_files(i) 
Next i 

start_flles(l) = file 

frm_main.flIes(l).Caption = start_files(l) 



Open file For Input As #1 

Line Input #1, textline * Number of models = 
Line Input #1, textline ' number of models 
n„ models = Val(textline) 
Line Input #1, textline * number of models 

code = "" 

For i = 1 To n_models 

Line Input #1, textline * number of models 

While Left(textline, 24) o " II II II II II II II II It II II- End of model" 

code = code & textline & vbCrLf 

Line Input #1, textline 
Wend 

frm_main.txt_code - code 
Next i 

Line Input #1 , textline ### end of ga code ### 
Line Input #1, textline last_gen 
Line Input #1, textline 
Iast_gen = Val(textline) 

Line Input #1, textline W## Start of genome ### 
Line Input #1, textline 

If Trim(textline) <> "Genome not defined" Then 
Line Input #1, textline 
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n_ bits = Val(textline) 
Line Input #1, textline 
Line Input #1, textline 
pop_size = Val(textline) 
Dim value As Integer 

ReDim genome(l To n_bits, 1 To pop„size) 
For i = 1 To n_bits 

For n = 1 To pop_size 

Input #1, value 

genome(i, n) = Val(value) 

Next n 
Next i 
End If 

Line Input #1, textline W# Begining of tokens ### 
While Trim(textline) o "### Begining of tokens ##F 

Line Input #1, textline 
Wend 

While Trim(textline) o "### End of tokens ##F 

While Trim(textline) o "Group stem =" 
Line Input #1, textline 
Wend 

Line Input #1, textline 
n_token__groups = n_token_groups + 1 

token„coIlection(n_token_groups).stem = Trim(textline) ' i.e., clear 

frm_tokens.lst_token_group.AddItemTrim(textline) 
While Trim(textline) o M N token sets =" 
Line Input #1, textline 
Wend 

Line Input #1, textline 

n_token_sets = Val(textline) 

While Trim(textline) o "N tokens =" 

Line Input #1, textline 

Wend 

Line Input #1, textline 

token_collection(n_token_groups).n_tokens = Val(textline) 
While Trim(textline) o "Token set F 
* Line Input #1, textline 
Wend 

Line Input #1, textline 
token__set_num = Val(textline) 
For n = 1 To n_token_sets 
While Trim(textline) o "Token set #" 
Line Input #1, textline 
Wend 

Line Input #1, textline 
token_set_num = Val(textline) 

token_collection(n_token_groups).add_token_set firm_tokens.Ist„token_sets 
token_num = 0 

For i = 1 To token_collection(n_token_groups).n_tokens 

Line Input #1, textline 
token__num = token_num + 1 

token_co!lection(n_token_groups).set_token token__set_num, token_num, textline 
Next i 
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Next n 

token_num = 0 
Line Input #1, textline 
Wend 

frm_tokens.lst_token_group.clear 
For i = 1 To n_token_groups 

frm_tokens.lst_token_group.AddItem token_collection(i).stem 
Next i 

Line Input #1, textline W## Begining of options ### 
Line Input #1, textline 

While Trim(textline) o "### End of options ###" 

code = Trim(textline) 
Line Input #1, textline 
textline = Trim(textline) 
Select Case code 
Case "mutation_rate" 

mutation_rate = Val(textline) 
Case "cross_over_freq" 

cross_over_freq = Val(textline) 
Case "frame shift prob" 

frame_shift_prob = Val(textline) 
Case "n_runs" 

n_runs = Val(textline) 
Case "theta_crit" 

theta„crit = Val(textline) 
Case "omega_crit" 

omega_crit = Val(textline) 
Case "sigma„crit" 

sigma_crit = Val(textline) 
Case "cov_crit" 

cov__crit = Val(textline) 
Case "success_criteria w 

success_crit = Val(textline) 
Case "pop_size" 

pop_size = Val(textline) 
Case "generationjimit" 

generationjimit = Val(textline) 
Case "call_method" 

call_method = Trim(textline) 
Case "upper fitness limit" 

upperjitness Jimit = Trim(textline) 
Case "lowerjltrtessjimit" 

Iower_fitness_limit = Trim(textline) 
Case "correlation criteria" 
corr_crit = Trim(textline) 

Case "save control" 

sa,ve_control = Trim(textline) 
Case "save best" 

save_best = Trim(textline) 
Case "save output" 

save_output = Trim(textline) 
Case "omega block" 
omega_block = Trim(textline) 
Case "seed type" 
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seed_type = Trim(textline) 
Case "seed value" 
seed_ value = Trim(textline) 
End Select 

Line Input #1, textline 

Wend 

Close #1 

* update options 

End Sub 



* Sub scale_fitness(fitness() As Single) 

* ' scale by emax, with max fitness at 90% of emax and min fitness at 10% of emax 
' * first find min and max 

* Dim max_fit As Single, min_fit As Single, ef50 As Single, sum_fit As Single 
' Dim i As Integer, n As Integer 

' Dim emax As Single, emin As Single 
'emin - 0.2 

' n = UBound(fitness) - LBound(fitness) 
'max_fit = -999999 
'min_fit== 999999 

'For i = LBound(fitness) To UBound(fitness) 
' If fitness(i) > max_fit Then max_fit = fitness(i) 
' If fitness(i) < min_fit Then minjit = fitness(i) 
' sum_ fit - sum_fit + fitness(i) 
'Nexli 

1 emax ~ sum_fit * 2 / n 

*ef50 = surnfit/n 

' emin == sum_fit * 0.2 / n 

* For i == LBound(fitness) To UBound(fitness) 

' fitness(i) = emax * fitness® A 2 / (ef50 A 2 + fitness(i) A 2) + emin 
'Nexti 

' MsgBox emax & Chr(9) & ef50 & Chr(9) & emin 
'End Sub 



Private Sub map_run() 

Dim n_ind As Integer, this__generation As Integer, max_generation As Integer 

Dim max„values() As Integer 

Dim mapped_values() As Integer 

Dim values() As Integer 

Dim binaryO As Boolean 

Dim n_genes As Integer 

Dim n_bits() As Integer 

Dim binjength As Integer 

'n_genes = 5 

'max_generation = 6 

'njnd = 3 

TteDiin max_vaiues(l To n_genes) 
UeDirn values(l To n_genes, 1 To n_ind) 
*ReDim mapped_values( I To n_genes, 1 To n_ind) 
'max^valuesCl)^ 5 
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End Sub 

'Sub map(values() As Integer, max_values() As Integer, mapped_values() As Integer, n_bits() As Integer) 

"take unmapped values (1 to max_values) to mapped (0 to 2 A ngenes -1) 

" values() is 2 dimensional, (n_genes by n_subject) 

" max_valus is 1 dimension (n_genes) 

" mapped values is 2 dimensional (n_genes by n_subject) 

" n_bits() is 1 dimensino, (n_genes) 

Dim i As Integer, n As Integer, p As Integer 

" n_bits = 1, max_value = 2;repeat = 0 

" l->0;2->l 

" n_bits = 2, max_value = 3; repeat = 1 

" 1 -> 0 ;2 -> 2: 3 -> 3 

" n_bits = 2, max_value = 4; repeat = 0 

" 1 ->0 ;2-> 1: 3->2;4->3 

" n_bits = 3, max_value = 5; repeat = 3 

" l->0;2->2: 3->4;4->6;5->7 

" n_bits = 3, max_value = 6; repeat = 2 

" 1 ->0;2->2: 3 -> 4; 4 -> 5; 5->6;6 -> 7 

" n_bits = 3, max_value = 7; repeat - 1 

" l->0;2->2: 3->3;4->4;5->5;6->6;7->7 

" n_bits - 3, max_value = 8; repeat = 0 

" 1 -> 0 ;2 -> 1: 3 -> 2; 4 -> 3; 5 -> 4; 6 -> 5; 7->6; 8->7 

" n_bits = 4, max_value = 9; repeat = 7 

" 1 -> 0 ;2 -> 2: 3 -> 4; 4 -> 6; 5 -> 8; 6 -> 10; 7->12; 8->14; 9 -> 15 
" n_bits = 4, max_value =10; repeat = 6 

" 1 -> 0 ;2 -> 2: 3 -> 4; 4 -> 6; 5 -> 8; 6 -> 10; 7->12; 8->13;9->14; 10 -> 15 
M n_bits - 4, max_value = 1 l;repeat = 5 

" 1 -> 0 ;2 -> 2: 3 -> 4; 4 -> 6; 5 -> 8; 6 -> 10; 7->ll; 8->12;9->13; 10 -> 14; 11->15 
" n_bits = 4, max_value = 12;repeat = 4 

" 1 ->0 ;2 -> 2: 3 -> 4; 4 -> 6; 5 -> 8; 6 -> 9; 7->10; 8->l 1;9->12; 10 -> 13; 1 1->14;12->15 
" n_bits = 4, max_value = 13;repeat = 3 

n 1 -> 0 ;2 -> 2: 3 -> 4; 4 -> 6; 5 -> 7; 6 -> 8; 7->9; 8->10;9->l 1;10 -> 12;11->13;12->14;13->15 
w n_bits = 4, max_value = 14;repeat = 2 

w 1 -> 0 ;2 -> 2: 3 -> 4; 4 -> 5; 5 -> 6; 6 -> 7;7->8; 8->9;9->10;10 -> 11;11->12;12->13;13->14;14->15 

Dim repeated As Integer, this _pop As Integer 

Tot this_j>op = 1 To UBound(values, 2) 

For i = LBound(vaIues, 1) To UBound(values, 1) 

Vepeated = 2 A n_bits(i) - max_values(i) 

rt want; 2 * values up to repeated, then 1 * value 

If values(i, this_pop) <= repeated + 1 Then 

1 mapped_values(i, this_pop) = (values(i, this_pop) - 1) * 2 

Else 

' mapped_values(i, this_pop) = (repeated) * 2 + (values(i, this_pop) - repeated - 1) 
End If 
Next i 

Next this_pop 
End Sub 

Sub unmap(values() As Integer, max_values() As Integer, mapped_values() As Integer, n_bits() As Integer) 

' take mapped values (0 to 2 A ngenes -1) back to unmapped (1 to max_values) 

' values() is 2 dimensional, (n_genes by n_subject) 

' max__valus is 1 dimension (n_genes) 

1 mapped values is 2 dimensional (n_genes by n_subject) 

* n_bits() is 1 dimensino, (n_genes) 

Dim i As Integer, repeated As Integer, thisjnd As Integer 
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start_pos = 1 
Next this_ind 
End Sub 

Sub mutate(binary() As Boolean, p_mutation As Single) 
Dim this_gene As Integer, this_ind As Integer 
For this_gene = 1 To UBound(binary, 1) 
For thisjnd = 1 To UBound(binary, 2) 

[f Rnd() < p_mutation Then binary(this_gene, this_ind) = Not (binary(this_gene, this_ind)) 
Next this_ind 
Next this_gene 
End Sub 

Function InStr_not(stringl As String, string2 As String, string3 As String) 
Dim position 1 As Long, position2 As Long, start As Long 
start = 1 

fonJestTextl = stringl 
*frm_test.Show 1 

position 1 = InStr(start, stringl, string2) 
position2 = InStr(start, stringl, string3) 
While positionl > 0 

If position2 <- positionl And position2 + Len(string3) >= positionl + Len(string2) Then 

start = start + positionl 
End If 

positionl = InStr(start, stringl, string2) 
position2 = InStr(start, stringl, string3) 
Wend 

InStr_not = positionl 
End Function 



Function from_to(start As Long, stringl As String, from_string As String, to_string As String) As String 

*this function return the string that starts with from_string and ends with to_string, 

* starting the search at start 

Dim new_string As String 

Dim start_pos As Long, end_pos As Long 

'find the start 

start__pos = InStr(start, stringl, from_string) 
' then the end position 

end_pos = InStr(start_pos, stringl, to_string) 

new_string = Mid(stringl, start_pos, end_pos + Len(to_string)) 

from_to = new_string 
End Function 

Public Function call_nm(drivename As String, pathname As String, controlfile As String, _ 
objl As Single, succl As Integer, covar As Integer, limit„str As String, check_out As Boolean) As 
Double 

Dim fitness As Double 

Dim theta(l To max_theta) As Single, setheta(l To max_theta) As Single 
Dim lltheta(l To max_theta) As Single, uitheta(l To max_theta) As Single 
Dim omega(l To 30, 1 To 30) As Single, seomega(l To 30, 1 To 30) As Single 
Dim sigma(l To 30, 1 To 30) As Single, sesigma(l To 30, 1 To 30) As Single 
Dim obj(l To 2) As Single, rm(l To 69, 1 To 69) As Single 
Dim i As Integer 
Dim success(l To 2) As Single 
success(l) = 999 
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success(2) = 999 

Dim a As Long, p As Integer, ntheta As Integer 
Dim out_val As Single 
ChDrive drivename 
ChDir pathname 

If controlfile <> "control" Then FileCopy controlfile, "control" 
1 need to sent check_out to nmv_exe if false then don't execute 

a =: nmv_exe(theta(l), lltheta(l), ultheta(l), omega(l, 1), sigma(l, 1), obj(l), success(l), setheta(l), 
seomega(l, 1), sesigma(l, 1), rm(l, 1)) 
fitness = calc_fitness(obj(), success(), setheta(), seomega(), sesigma(), rm(), _ 
theta„crit, omega_crit, sigma__crit, cov_crit, ntheta) 
run_number - run_number + 1 
' hit upper of lower limits? 

For i = 1 To ntheta 
If theta(i) o 0 Then 9 check for divide by zero 
If Abs(theta(i) - Utheta(i) / theta(i)) < 0.00000001 Or _ 
Abs(theta(i) - ultheta(i) / theta(i)) < 0.000000001 Then 
limit_str = limit_str & Trim© & 
End If 
End If 
Nexti 

objl = obj(l): succl = success(l): covar = success(2) 
call_nm = fitness 
End Function 

Private Function calc_fitness(obj() As Single, success() As Single, setheta() As Single, _ 
seomega() As Single, sesigma() As Single, rm() As Single, _ 
theta_crit As Single, omega_crit As Single, sigma_crit As Single, _ 
cov_crit As Single, ntheta As Integer) As Single 

' return calculated value for fitness, start with obj, subtract theta_crit for each estimated theta etc 
Dim i As Integer, neff As Integer, n As Integer 
Dim nsigma As Integer 

Dim corr_pen As Single ' correlation > 0.95 penalty 
Dim cov_pen As Single 
'count theta, etas and sigmas 

' read from file inputs, created by cfiiex (and thetas) in nmtran 
Dim iline As String 
Dim s_pen As Single 

Diitn nomega_sets As Integer, nomega As Integer 
Dim nsigma„sets As Integer 

Dim fixd As Integer, block_num As Integer, nval As Integer 
Dim nthfxd As Integer, nomfxd As Integer, nsgfxd As Integer 
MsgBox CurDir 

If Dir("INPUTS\ vbNormal) o "" Then 

Open "inputs" For Input As #1 

Else 

calcjitness = 999999999.99 
obj(l) = 999999999.99 
Exit Function 
End If 

Line Input #1, iline 

* FIRST LINE IS " NTHETA, NOMEGA, NSIGMA, NTHFXD, NOMFXD, NSGFXD" 
Input #1, ntheta, nomega_sets, nsigma^sets, nthfxd, nomfxd, nsgfxd 
Line Input #1, iline 
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'THIRD LIND IS M NOMBLK , OMDIM, OMFIX" 
For i = 1 To nomega_sets 
Inpul #1, block_num, nval, fixd 
' get # of etas in block 
If fixd = 0 Then 
For n = 1 To nval 
nomega = nomega + n 
Next n 
End lf'fixd = 0 
Nexti 

Line Input #1, iline 
For i = 1 To nsigma_sets 
Input #1, block_num, nval, fixd 
nsigrna = nsigma + nval * (1 - fixd) 
Nexti 

* loop through srm to see if any are larger than 0.95 
neff == ntheta + nomega + nsigma 

corr_pen = 0 

If success(2) = 0 Then ' only do if cov step ran 
Fori= 1 To neff 
For n = 1 To i - 1 * only do lower triangle 
Ifrm(i, n)> 0.95 Then 
eorr_pen = corr_crit 
Exit For 
End If 
Next n 

If corr_pen > 0 Then Exit For 
Nexti 
End If 

* now calcuate fitness 
If suceess(2) > 0 Then 
cov_pen = cov_crit 
Else 

cov_pen = 0 
End If 

If suocess(l) > 0 Then 
s_pen = success_crit 
cov jpcn = cov_crit 
Else 

s_pen = 0 
End If 

calc_fitness = obj(l) + theta_crit * ntheta + omega_crit * nomega 
+ sigma_crit * nsigma + cov_pen + corr_pen + s„pen 

Close #1 
End Function 
Private Sub get_files(files) 
files(I) = "nonmem.dll" 
files(2) = "freport" 
files(3) = "nonmem.lib" 
files(4) = M nonmem.exp" 
files(5) = "FWARN" 
files(6) = "PRDERR" 
files(7) = M fsubs" 
files(8) = "fsubs.obj" 
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mean = sumx / i 
Ifi> IThen 

sd = Sqr((i * sumxx - (sumx * sumx)) / (i * (i - 1))) 
Else 
sd = 0 
End If 

'now draw line from (mean -2d,lower limit) and (mean + 2sd, upper limit) 
If sd = 0Then 
slope - 0 
Else 

slope = (upper_fitness_limit - lower_fitness_limit) / (4 * sd) 

' y ~ mx + b 

' b == y - mx 

b = 1 - slope * mean 

End If 

For n = 1 To i 

new_fitness(n) = b + slope * fitness(n) 

If new_fitness(n) < lower JTitnessJimit Then new Jitness(n) = lower_fitness Jimit 
If new_fitness(n) > upper_fitness_limit Then new_fitness(n) = upper Jitnessjirnit 



Next n 

Dpen M c:\ga\fitness" For Output As #1 
Dim n_pop As Integer 
For n_pop = 1 To i 

Write #1, temp_fitness(n_pop); new_fitness(n_pop) 
Next n_pop 
Close #1 
End Sub 

Sub select_pairs(pairs() As Integer, cum_fitness() As Single) 

• select individuals based on fitness, put then into pairs 

Dim rand As Single, i As Integer, p As Integer, n As Integer, n_ind As Integer 

'Open "c:\ga\pairs" For Output As #1 

n_ind = UBound(cum_fitness) / 2 

For i = 1 To 2 

For n = 1 To n_ind 

rand = Rnd() 

P :=l 

While rand > cum_fitness(p) 

p = p+l 

Wend 

pairs(i, n) = p 

* Print #1, rand; cum_fitness(p); p 
Next n 

Next i 
Oose#l 
End Sub 

Sub load_data(sheet As vaSpread, dir_narne As String) 

frm_graphics.CommonDialogLfilename = dir_name & "\*.dat" 

Dim Data() As Single, temp As String, varname As String, tmp_num As Integer 

Dim data_row() As Single, mdv_col As Integer, n_coI As Integer 

Dim row_string As String 

Dim this_col As Integer, this_row As Integer 

Dim next_position As Integer, last_position As Integer 

frm„graphics.CommonDialogl.DialogTitle= "NONMEM graphics" 
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frmi_graphics.CommonDiaIog 1 .Sho wOpen 

If InStr(l, frm_graphics.CommonDialogl. filename, "*") <> 0 Then Exit Sub 
If Dir(frm_graphics.CommonDialogl. filename, vbDirectory) = MH Then 
MsgBox ("File not found") 
Exit Sub 
End If 

frm_graphics.lst_x_axis.clear 
frm_graphics.lst_y_axis.clear 
frm_graphics.lst„sort_col.clear 

Open frm_graphics.CommonDialogl. filename For Input As #1 
Tind start of table 

While Left(Trim(temp), 12) o "TABLE NO. 1" 

Line Input #1, temp 

Wend 

frm_graphics.Show 
*read headers 
temp = Input(l,#l) 
frm_graphics.spr_data.row = 0 
' read whole line then search for tokens 
Line Input #1, row_string 
' at least position 1 1 has to be character 
next_position = InStr(ll, row_string, " ") 
last_position = 1 
* find the mdv column 
Do While next_position o 0 
lhis_col = this_col + 1 

varname = Mid(row_string, last_position, next_position - last_position) 

* if varname is not alpha, there are no variable names 
If IsError(Val( varname)) Then 

MsgBox ("No variable names, next time please use the ""One Header"" option") 
Exit Do 
End If 

If Trim( varname) = "MDV" Then mdv_col = this_col 

frm_graphics.spr_data.col = this_col 

firm_graphics.spr_data. value = Trim( varname) 

frm_graphics.lst_x_axis. Addltem Trim(varname) 

frm_graphics.lst_y_axis. Addltem Trim(varname) 

frm_graphics.lst_sort_col.AddItem Trim( varname) 
Iast_position = next_position + 1 

* find next space in row 

next_position = InStr(last_position +11, row_string, 11 ") 
Loop 

' then one more 
this_col = this_col + 1 
If mdv_col = 0 Then 

MsgBox ("No MDV column found, all data will be displayed") 
End If 

varname = Mid(row_string, last„position, Len(row_string) - last_position +1) 
If Trim( varname) = "MDV" Then mdv_col - this_col 
frm_graphics.spr_data.col = this_coI 
frm_graphics.spr_data. value = Trim( varname) 
frrn_graphics.ist_x_axis.AddItem Trim( varname) 
frm_graphics.lst_y_axis.AddItemTrim( varname) 
frm_graphics.lst„sort_col. Addltem Trim( varname) 
n_col = this_coI 
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ReE)im data_row(l To n_col) 
' read data* 

While EOF(l) = False 
Input #1, row_string 
For this_col = 1 To n_col 

data_row(this_coI) = Val(Mid(row_string, 1 + (this_coI - 1) * 12, 12)) 
Next this_col 

If mdv_col o 0 Then ' can we check if mdv = 1 ? 
If data_row(mdv„col) = 0 Then 
this_row = this_row + 1 

* use data 

frm_graphics.spr_data.row = this„row 
For this_col = 1 To n_col 
frm_graphics.spr_data.col = this_col 
frm_graphics.spr_data. value = data_row(this_col) 
Next this__col 
End If 
Else 

' use it regardless if mdv not present 
this_row = this__row + 1 
frm_graphics.spr_data.row - this_row 
For this_col = 1 To n_col 
firm_graphics.spr_data.col = this_col 
frm_graphics.spr_data. value = data_row(this_col) 
Next this_col 
End If 
Wend 
Close #1 

fnr i_graphics,spr_data.MaxRows = this_row 
*fn]a_graphics_interface.Show 
End Sub 

Sub scan_tokens() 

'look for 0, (1-0), unmatched (), unmatched { }, {(}), ({ }), ({)} 
* only if they occur before a ";" in the token 

Dim short_token As String, token As String, i As Integer, ok As Boolean 

Dim this_token_group As Integer, this_token_set As Integer, this_token As Integer 

Dim posl As Integer, pos2 As Integer 

ok = True 

For this_token_group - 1 To n_token__groups 
For this_token_set = 1 To token_collection(this_token_group).n_token„sets 
For this_token = 1 To token„collection(this_token_group).n_tokens 
token = token_collection(this_token_group).get_token(this_token_set, this_token) 

* first get the part left of 

If InStr(token, ";") = 0 Then 
short_token = token 
Else 

short_token = Left(token, InStr(l, token, ";") - 1) 
End If 

'look for THETA(l-0)x 
For i = 0 To 9 

If InStr(UCase(short_token), "ETA(" & Trim(str(i)) & ")") <> 0 Then 
MsgBox ("Number M & str(i) & M in token = M & token & " stem = " & 
token„collection(this_token_group).stem & „ 

n Token set # " & this_token_set & " Token # " & this_token) 
ok = False 
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End If 

If InStr(UCase(short_token), "EPS(" & Trim(str(i)) & T) <> 0 Then 
MsgBox ("Number " & str(i) & " in token = " & token & " stem = " & 
token_collection(this_token_group).stem & _ 

" Token set # " & this_token_set & " Token # " & this.token) 
ok = False 
End If 
Nexti 

' check for unbalance () have to loop through until all ( are found 
* before next ( 

posl = I 'position of first ( 
pos2 = 1 ' position of next ( 
While InStr(posl + 1, short_token, "(") <> 0 

posl = InStr(posl + 1, short_token, "(") 

If posl >0 Then 
If InStr(posl, shortjoken, w ) n ) = 0 Then 

MsgBox ("Unmatched ( in 11 & token & " stem = " & token_collection(this_token_group).stem & _ 

M Token set # " & this_token_set & " Token # " & this_token) 
ok = False 
End If 
End If 
Wend 

Next this_token 
Next this_token_set 
Next this_token_group 
If ok = True Then MsgBox "No errors found" 
End Sub 

Public Function make_int(this_ind As Integer) As Double 

'need to start with binary (genome) not values 

Dim this_digit As Integer, Iength_genome As Integer, rval As Double 

length_genome = UBound(genome, 1) 

For this_digit = 1 To length_genome 

If genome(this_digit, this_ind) = True Then rval = rval + 2 A (this_digit - 1) 
Next this_digit 
make_int = rval 
End Function 

Public Sub clear_form(Form As vaSpread) 
Dim this_row As Integer, this_col As Integer 
With Form 

For this_row = 1 To n_runs 
.row = this_row 

For this_col = 1 To 8 

.col = this_col 

.text = "" 

Next this_col 
Next this_row 
End With 
End Sub 



Public Sub get_stats(directory As String, obj As Single, fitness As Single, covar As Boolean, success As 
Boolean) 

' read the files parms and return the statistics, send to calc_fitness 
ChDir directory 
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Close #1 

If DirOTARMS", vbNormal) <> Then 
Open "PARMS" For Input As #1 
End If 
Close #1 
End Sub 

Public Function check_token(box As TextBox) As Boolean 

check_token = True 

Dim temp_str As String 

Dim n_parens As Integer 

Dim pos As Integer 

tentip_str = box.text 

pos = InStr(l, temp_str, " ") 

While pos o 0 

temp_str = Left(temp_str, pos - 1) & _ 

Right(temp_str, Len(temp_str) - pos) 
pos = InStr(l, temp_str, " ") 
Wend 

box.text = temp_str 

pos = InStr(l, temp_str, "(") 

While pos o 0 

n_parens = n_parens + 1 

ternp_str = Left(temp_str, pos - 1) & _ 

Right(temp_str, Len(temp_str) - pos) 
pos = InStr(l, temp_str, "(") 
Wend 

' now subtract one for each ")" 

pos = InStr(l, temp_str, ,, ) ,, ) 

While pos o 0 

n_parens = n_parens - 1 

temp_str = Left(temp_str, pos - 1) & _ 

Right(temp„str, Len(temp_str) - pos) 
pos = InStr(l, temp_str, M )") 
Wend 

If n_parens > 0 Then 

MsgBox "Too many ""("V 

box.SelStart = InStr(l, box.text, "(") - 1 

box.SelLength = 1 

check_token = False 

Exit Function 
End If 

If n_parens < 0 Then 

MsgBox "Too many " H )"V 

box.SelStart = InStr(l, box.text, ")") - 1 

box.SelLength = 1 

check_token = False 

Exit Function 
End If 

* and now the { } 

temp„str - box.text 

pos = InStr(l, temp_str, M {") 

While pos o 0 

n__parens = n_parens + 1 

temp_str - Left(temp_str, pos - 1 ) & _ 

Right(temp_str, Len(temp_str) - pos) 
pos = InStr(l, temp_str, "{") 
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Wend 

' now subtract one for each ")" 

pos = InStr(l, tempos tr, "}") 

While pos o 0 

n„parens = n_parens - 1 

temp_str = Left(temp_str, pos - 1) & _ 

Right(temp_str, Len(temp_str) - pos) 
pos = InStr(l, temp_str, "}") 
Wend 

If n_parens > 0 Then 

MsgBox "Too many ""{'"V 

box.SelStart = InStr(l, box.text, "{") - 1 

box.SelLength = 1 

checkjoken = False 

Exit Function 
End If 

If n_parens < 0 Then 

MsgBox "Too many ««}"V 

box.SelStart = InStr(l, box.text, " }") - 1 

box.SelLength - 1 

check_token = False 

Exit Function 
End If 

End Function 



Public Sub load_results(spread As vaSpread, chart As MSChart) 

' recurse through the directories, calculate the fitness for each run and write to spread sheet 
Dim i As Integer 

Dim n_ind As Integer, thisjnd As Integer 

Dim cur_gen_dir As String, cur_ind_dir As String, this_row As Integer 
Dim obj(l To 2) As Single, success(l To 2) As Single, covar As Boolean 
Dim fitness() As Double, scaled_fitness() As Single, temp_fitness() As Single 
Dim n__gen As Integer, max_ind As Integer, max_gen As Integer, max_x As Single 
' how many individuals 

this_gen = 1: this_ind = 1: max_gen = 0: max_ind = 0 
this_row = 0 

<cur_gen_dir = home_directory & T & Trim(str(this_gen)) 
*cur_ind_dir = cur__gen_dir & "V & Trim(str(this_ind)) 
'For this_gen = 1 To last_gen 

While Dir(cur_gen_dir, vbDirectory) = Trim(str(this_gen)) 

' If this_gen > max_gen Then max_gen = this_^en 

' While Dir(cur_ind_dir, vbDirectory) = Trim(str(this_ind)) 

' If this_ind > max_ind Then max„ind = this_ind 

1 this_ind = this__ind + 1 

' cur_ind_dir = cur_gen_dir & "\" & Trim(str(this_ind)) 
' Wend 'cur_ind_dir 
this_ind - 1 

bur_gen_dir = home_directory & "\" & Trim(str(this_gen)) 

Tfext this_gen 

\his_gen = last_gen 

Wend *cur_gen_dir 

ReDim fitness(l To pop_size) 

ReDim scaled_fitness(l To pop„size): ReDim temp_fitness(l To pop_size) 
' initialize plot axis for generations 
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frm_main.spr_resuIt.MaxRows = pop_size * generationjimit 
max_x = generation_limit 
initiaIize_plot generationjimit 
this_gen = 1: this_ind - 1 
For this_gen = 1 To last_gen 

cur_gen„dir = home_directory & T & Trim(str(this_gen)) 
While Dir(cur_gen_dir, vbDirectory) = Trim(str(this„gen)) 
'While Dir(curjnd_dir, vbDirectory) = Trim(str(this_ind)) 
For this_ind = 1 To pop_size 

cur_ind_dir = cur_gen_dir & "V & Trim(str(this_ind)) 
' we need obj success, covar, fitness, boundary for theta, 
' the calc scaled fitness 

* read input, parms 

readjresults cur_ind_dir, obj, success, covar, fitness(this_ind) 
this_row = this_row + 1 
With frm_main.spr_result 

.row = this_row 

.col- 1: .text=obj(l) 

.col = 2: If success(l) = 0 Then .text = "Yes" Else .text = "No" 
.col = 3: If success(2) = 0 Then .text = "Yes" Else .text = "No" 
.col = 4: .text = fitness(this_ind) 
.col = 8: .text = this__gen 
.col - 9: .text = this_ind 
End With 

temp_fitness(this_ind) = fitness(this_ind) 
' this_ind = this_ind + 1 

* cur_ind_dir = cur_gen_dir & "V 1 & Trim(str(this_ind)) 
Next this Jnd * end of individual while 

scalejitness scaled_fitness(), temp_fitness() 
' update plot 

update .plot temp_fitness(), scaled_fitness() 
' this_gen = this_gen + 1 

*cur_gen_dir = home.directory & "\" & Trim(str(this_gen)) 
*thisjnd= 1 

*cur_ind_dir = cur_gen_dir & 'V & Trim(str(this_ind)) 
Next this_gen 

runjiumber = last„gen * pop_size 
frm_main.pgb_gen = last_gen 
frm_main.pgb_gen.max = generationjimit 
frm_main.pgb_ind.max = pop_size 

frm_main.pgb_ind = 1 

Wend ' end of generation while 
MsgBox frm_main.spr_result.MaxRows 
End Sub 



Sub read_results(this_dir As String, ByRef obj() As Single, ByRef success() As Single, covar As Boolean, 
fitness As Double) 

Dim theta(l To maxjheta) As Single, setheta(l To max_theta) As Single 

Dim ntheta As Integer, nomega As Integer, nsigma As Integer, ntheta_fixed As Integer, nomega_fixed As 
Integer, nsigma^fixed As Integer 

Dim Utheta(l To max_theta) As Single, ultheta(l To max_theta) As Single 
Dim omega(l To 30, 1 To 30) As Single, seomega(l To 30, 1 To 30) As Single 
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Exit Sub 
End If 
Close 1 
End Sub 



Function count_max_omega() As Integer 

* go to the tokens and find how many unique omegas are there. 

* count the number of unique ETA(??) where ?? is A - AZ 
Dim used_eta(l To 52) As Boolean 

Dim this_eta As Integer, token_string As String, check„string As String 
Dim this_token_group As Integer, this_token_set 
Dira n_omega As Integer, n_token_sets As Integer 
Dim this_token As Integer, n__tokens As Integer 
Dim tesLstring As String, n_sets As Integer 

Dim control_string As String, n_token_pmegas 'number of omegas in tokens (ie., "A") 
controLstring = UCase(frm_main.txt_code) 

* well assume there are less than 10 omegas in the control file and less than 27 on the token sets 
tesLstring = "ETA( M & Trim(Chr(49)) & ")" 

' change all the THETAs to xxx 

controLstring = sub_string(control_string, "THETA", "XXXXX") 
While InStr(l, controLstring, test_string) o 0 And n_omega < 10 
n_omega - n_omega + 1 

tesLstring = "ETA(" * Trim(Chr(49 + n_omega)) & ")" 
Wend 

For this_token_group = 1 To n_token _groups 
njoken_sets = token_collection(this_token_^roup).n_token_sets 
For this_token_set = 1 To n_token_sets 

* loop through set to see if it is used 

n .tokens = token_collection(this_token_group).n_tokens 

For this_token = 1 To n_tokens 
token_string = token_string & vbCrLf & token_collection(this_token_group).get_token(this_token__set, 
thisjoken) 

Next this_token 
Next this_token_set 
Next this_token_group 
' get rid of THETA (to XXXX) 

token_string = sub„string(token„string, "THETA", "XXXXX") 
' frm_text.txt_text = token_string 
*frm_text.Show 1, frm_main 
test_string = "{ETA( M & Trim(Chr(65)) & ")}" 
While InStr(l, token_string, test_string) o 0 
n_token_omegas = n_token__omegas + 1 

tesLstring = ** { ETA(" & Trim(Chr(64 + n_token_omegas)) & ")}" 
Wend 

count_max_omega = n_omega + n_token_omegas 
End Function 

Function count_etan(controI As String) As Integer 
Dim controLstring As String, test_string As String 
Dim test_n As Integer 
controLstring = UCase(controI) 

' well assume there are less than 10 omegas in the control file and less than 27 on the token sets 
test_n ~ 1 

tesLstring = "ETA(" & Trim(str(test_n)) & 
'change all the THETAs to xxx 
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controLstring = sub_string(controI_string, "THETA", "XXXXX") 
While InStr(l } controLstring, test_string) <> 0 And n_omega < 10 
test_n = test_n + 1 

test.string = "ETA(" & Trim(str(test_n)) & 
Wend 

count_etan = test_n - 1 
End Function 
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File token_group.ds 



VERSION 1.0 CLASS 
BEGIN 

MultiUse - -1 'True 
END 

Attribute VB_Name = " token_group" 
Attribute VB_GlobalName Space = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 

Attribute VB„Ext_KEY = " SavedWithC lass Builder " , "Yes" 
Attribute VB_Ext_KEY = tt Top_Level" , "Yes" 
'local variable (s) to hold property value (s) 
Private local_stem As String 'local copy 

Private local_n_tokens As Integer ' number of tokens in set , e.g., 

theta (next) , (0,1,100) = 2 tokens 

Private local_n_token_sets As Integer 

Private token_sets(l To 50, 1 To 10) As String 

Option Explicit 

Public Sub remove_token„set (ByVal position As Integer) 
Dim row As Integer, col As Integer 
For row = position To local_n_token_sets - 1 
For col = 1 To n_tokens 

token_sets(row, col) = token_sets (row + 1, col) 
Next col 
Next row 

local_n_token_sets = local_n_token_sets - 1 
End Sub 

7 Private all_sets As Collection 

Public Sub add__token_set (lst_sets As ListBox) 

local_n_token_ sets = local_n_token_sets + 1 

get_token_set lst_sets 

End Sub 

Public Property Get stem{) As String 

stem = local_stem 
End Property 

Public Property Let stem(ByVal lstem As String) 

local_stem ~ lstem 
End Property 

Public Property Get n_tokens ( ) As Integer 

n_tokens = local_n__tokens 
End Property 

Public Property Get n_token_sets ( ) As Integer 

n__token_sets = local_^n_token_sets 
End Property 

Public Property Let n_tokens(n As Integer) 

local_n_tokens = n 
End Property 

Public Sub get__token_set ( this_list As ListBox) 
Dim i As Integer, n As Integer 
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Dim tok_str As String 
this_list . clear 

For i = 1 To local_n_token_sets 
tok_str = i & " 

For n = 1 To local_n_tokens 

tok_str = tok_str & "(" & token_sets { i , n) & " ) " 
Next n 

this_list . Addltem tok_str 
Next 

End Sub 

Public Sub get_tokens (this__list As ListBox, this„token_set As Integer) 

Dim i As Integer 

this_list . clear 

If this__token_set <> 0 Then 

For i = 1 To local„n_tokens 

this_JList. Addltem ( & token_sets ( this_token_set , i) & ") " 
Next i 
End If 
End Sub 

Public Sub get_tokens_lines (this_list As ListBox, this_token_set As 
Integer) 

Dim i As Integer 
Dim str As String 

Dim start As Integer, last As Integer 

this_list , clear 

For i = 1 To local_n_tokens 

str = token_sets ( this__token_set , i) 

While InStrd, str, "{crlf}") <> 0 

start = InStr(l, str, "{crlf}") 

last = Len(str) - InStrd, str, "{crlf}") + Len ( n {crlf } " ) 
str = Trim(Left (str, start) & vbCrLf & _ 
Trim (Right (str, last) ) ) 

Wend 

this_list .Addltem " ( H & str & ") " 
Next i 
End Sub 

Public Function get_token(ByVal set_num As Integer, ByVal token_num As 
Integer) As String 

get_token = token_sets (set_num, token_num) 
End Function 

Public Function get_token_with_lines (ByVal set_num As Integer, ByVal 
token_num As Integer) As String 
Dim str As String 

Dim start As Integer, last As Integer 
str = token_sets (set_num, token_num) 
While InStrd, str, "{crlf}") <> 0 
start = InStrd, str, "{crlf}") - 1 

last = Len(str) - InStrd, str, ""{crlf}") - Len ( " {crlf }" ) + 1 
str = Trim{Left (str, start) & vbCrLf & _ 
Trim(Right (str , last) ) ) 

Wend 

get_token_with_lines = str 
End Function 
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Public Sub set_token(ByVal set_num As Integer, ByVal token_num As 
Integer, value As String) 

' we need to replace crlf by another character - {crlf} 
Dim start As Integer, last As Integer 
While InStr(l, value, vbCrLf) <> 0 
start = InStr(l, value, vbCrLf) - 1 
last = Len (value) - start - 2 

value = Trim (Left (value, start)) & "{crlf}" & _ 
Trim(Right (value, last) ) 

Wend 

t oken _s e t s { s e t_num , t oken_num ) = va 1 ue 
End Sub 

Public Sub clear () 

Dim i As Integer, n As Integer 

For i = 1 To n_token_sets 

For n = 1 To n_tokens 

token_sets ( i , n) = 

Next n 
Next i 

local„n_token_sets = 0 
local__n__tokens = 0 
locales tern = " " 
End Sub 
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393216 
3 
2 

520 

{OBE35203-8F91-11CE-9DE3-OOAA004BB851} 
= "Arial" 
11.25 
0 

400 

= 0 'False 
0 'False 
~ 0 'False 



Height 
Left 

Tab Index 
Top 
Width 
_ExtentX 
_ExtentY 

_Version = 
TabOrientation = 
Tab 

TabHeight 

BeginProperty Font 
Name 
Size 
Charset 
Weight 
Underline 
Italic 

Strikethrough 
EndProperty 

TabCaption(O) = "Control" 
TabPicture(O) = " f rm_main. f rx" : 0442 
Tab ( 0 ) . ControlEnabled= 0 ' False 
Tab ( 0 ) . Control ( 0 ) = n txt_code " 
Tab{0) .ControlCount= 1 
TabCaption(l) = "Result Plot" 
TabPicture(l) = n f rm_main. f rx" : 045E 
Tab(l) .ControlEnabled= 0 'False 
Tab ( 1 ) . Control ( 0 ) = "MSChartl " 
Tab ( 1 ) . Con t r o ICount = 1 
TabCaption(2) = "Results table" 
TabPicture (2) = " f rm_main. f rx" : 047A 
Tab ( 2 ) . ControlEnabled= - 1 ' True 
Tab (2) .Control (0)= "spr_result" 



Tab (2) .Control (0) .Enabled= 
Tab (2) .ControlCount= 1 
Begin VB.TextBox txt_code 



'False 



Height 
Left 

MultiLine 

ScrollBars 

Tablndex 

Top 

Width 



7815 

-74160 

- 1 ' True 

2 'Vertical 

7 

240 
9495 



End 

Begin MSChartLib . MSChart MSChartl 
Height = 7815 

Left = -74880 

OleObjectBlob = " f rm_main . f rx" :049 6 
Tablndex = 1 

Top = 120 

Width = 10815 

End 

Begin FPSpread . vaSpread spr_result 
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Height = 793 5 

Left = 240 

Tablndex = 8 

Top = 120 

Width = 11115 

_Version = 131077 

_ExtentX = 19606 

„ExtentY = 13996 

_StockProps = 64 

BeginProperty Font { OBE35203-8F91-11CE-9DE3-OOAA004BB851 } 

Name = "MS Sans Serif" 

Size = 8.25 

Charset = 0 

Weight = 7 00 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 

MaxCols = 11 

ScrollBars = 2 
ScrollBarShowMax= 0 'False 

SpreadDesigner = " frm_main. frx" : 252A 

UserResize = 2 

VisibleCols = 500 

VisibleRows = 500 
End 

End 

Begin CoractlLib . ProgressBar pgb_ind 

Height = 210 

Left = 1440 

Tablndex = 2 

Top = 8400 

Width = 5175 

__ExtentX = 9128 

_ExtentY = 370 

_Version = 327682 

Appearance = 1 

End 

Begin Comet ILib. ProgressBar pgb_gen 



Height 




210 


Left 




1440 


Tablndex 




4 


Top 




8760 


Width 




5175 


„ExtentX 




9128 


_ExtentY 




370 


_Version 




327682 


Appearance 




1 



End 

Begin VB. Label Label3 

Caption = "Unique models' 

Height = 255 

Left = 10080 

Tablndex = 13 

Top = 8640 

Width = 1335 

End 
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Begin VB. Label lbl„count 
BackColor 
BorderStyle = 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Labell 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Label2 
Caption = 
Height = 
Left 

Tablndex 
Top 
Width 
End 

Begin VB.Menu file 
Caption = 
WindowList = 
Begin VB.Menu new 

Caption = 
End 

Begin VB.Menu open 

Caption = 
End 

Begin VB.Menu Save 
Caption = 

End 

Begin VB.Menu Load 

Caption - 
End 

Begin VB.Menu save_as 
Caption = 

End 

Begin VB.Menu Exit 

Caption = 
End 

Begin VB.Menu break 

Caption = 
End 

Begin VB.Menu files 
Caption 

Index = 
Visible = 
End 

Begin VB.Menu 
Caption 



&H80000009& 
1 'Fixed Single 
"0" 
375 
11640 
12 

8520 
855 



" Individuals" 
255 
360 
6 

8400 
975 



" Generations " 
255 
360 
5 

8760 
1095 



File" 
1 ' True 

"&New" 



"&Open" 



"&Save" 



"Load results' 



"S&ave As" 



" E&xit" 



'Files" 



' False 



files 



'Files' 
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Index = 2 

Visible = 0 'False 

End 

Begin VB.Menu files 

Caption = "Files" 

Index = 3 

Visible = 0 'False 

End 

Begin VB.Menu files 

Caption = "Files" 

Index = 4 

Visible = 0 'False 

End 

End 

Begin VB.Menu edit 

Caption = "Edit" 

Begin VB.Menu Edit_token_set 

Caption = "Edit Token Set" 

End 

Begin VB.Menu sort 

Caption = "Sort Results" 

End 

Begin VB.Menu print 

Caption = "Print" 

End 

Begin VB.Menu copy- 
Caption = "Copy" 

End 

End 

Begin VB.Menu Run 

Caption = "Run" 

Begin VB.Menu check_out 

Caption = "Check Out" 

End 

Begin VB.Menu ga_Run 

Caption = "GA Run" 

End 

Begin VB.Menu continue_run 

Caption = "Continue GA run" 

End 

Begin VB.Menu full_grid 

Caption = "Full Grid Search" 

End 

Begin VB.Menu debug 

Caption = "Debug" 

End 

End 

Begin VB.Menu option 

Caption = "Options" 

Begin VB.Menu settings 

Caption = "Settings" 

End 

End 

Begin VB.Menu help 

Caption = "Help" 

End 

End 
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Attribute VB_Name = "frm_main" 
Attribute VB_Global Name Space = False 
Attribute VB„Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Private cur_model_f ile_name As String 

Private file„name As String ' just the file name without the path 
Option Explicit 

Private Sub but_stop„run_Click ( ) 
stop_run = True 
End Sub 

Private Sub copy_Click() 
If SSTabl.Tab = 1 Then 
MSChartl . Edit Copy 

MsgBox "result plot chart copied to clipboard" 
End If 

If SSTabl.Tab = 2 Then 
spr_result . col = -1 
spr_result . row = -1 
spr_result .Action = 22 
End If 
End Sub 

Private Sub debug_Click( ) 
f rm_debug . Show 1, Me 
End Sub 



Private Sub f iles_Click ( Index As Integer) 

cur_model_f ile_name = start__files (Index) 
get_model cur_model_f ile_name 
Dim pos As Integer 
pos = 1 

While InStr(pos + 1, cur_model_f ile_name, "X") > 0 
pos = InStr(pos + 1, cur_model_f ile__name, m \ m ) 
Wend 

home_directory = Lef t (cur_model_f ile_name, pos - 1) 
ChDir (home__directory) 

file_name = Right (cur_model_file_name, Len ( cur_model_f ile_name) - pos) 
home_drive = Lef t (home_directory, 2) 
ChDr i ve { home__dr ive ) 
End Sub 

Private Sub Form_Unload (Cancel As Integer) 
End 

End Sub 

Private Sub Load_Click() 

If MsgBox ("Load results from " & home_di rectory & " ?", vbOKCancel) <> 
vbOK Then Exit Sub 

load_results frm_main. spr_result , frm_ma in .MSChartl 
End Sub 
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Private Sub opt_pause_Click ( ) 
op t__pause . Enabled = False 
paused = True 
Op t„resume . Enabled = True 
End Sub 

Private Sub opt_pause_DblClick ( ) 
opt_pause. Enabled = False 
paused = True 
Opt_resume. Enabled = True 
End Sub 

Private Sub Opt_resume_Click ( ) 
Opt„resume. Enabled = False 
paused = False 
opt_pause. Enabled = True 
End Sub 

Private Sub Opt_resume_DblClick( ) 

Opt_resuine. Enabled = False 

paused = False 

op t_pause. Enabled = True 

End Sub 

Private Sub print_click ( ) 
If SSTabl.Tab = 1 Then 
End If 

If SSTabl.Tab = 2 Then 
spr_result . col = -1 
spr_re suit .row = -1 
spr__result .Action = 22 
End If 

End Sub 

Private Sub New_Click() 
Me . txt_code . text = 
s e t_de f au 1 t__op t i ons 
End Sub 

Private Sub set_def ault_options ( } 
End Sub 



Private Sub sort_Click() 
f rm_sort_results . Show 
End Sub 

Private Sub spr_result_Click (ByVal col As Long, ByVal row As Long) 
Dim gen As Integer, ind As Integer 
Dim text As String, textline As String 
Dim file_name As String 
Select Case col 
Case 5 

spr_result .col = 8 
spr_result . row = row 
If spr_result .value = " Then 
MsgBox "No results available" 
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Exit Sub 
End If 

If save_output = False Then 

MsgBox "Output file not saved, see options" 
Exit Sub 
End If 

gen = spr_result .value 

spr_result . col = 9 

ind = spr_result. value 

If spr_result .value = " " Then 

MsgBox "No results available" 

Exit Sub 

End If 

file_name = home_di rectory & " \" & gen & " \ " & ind & "\ output" 
If Dir(fil e_name , vbNorma 1 ) = " " Then 
MsgBox "Output file not found" 
Exit Sub 
End If 

Open file__name For Input As #1 

Do While Not E0F(1) ' Loop until end of file. 

Line Input #1, textline ' Read line into variable. 

text = text & textline & vbCrLf 

Loop 

frm_text .Caption = "Output file" 
f rm_text . txt_text = text 
Me . Hide 
f rm_text . Show 
Close #1 ' Close file. 
Case 6 

spr_result .col = 8 
spr_result . row = row 
If spr_result. value = " " Then 
MsgBox "No results available- 
Exit Sub 
End If 

If save„control = False Then 

MsgBox "control file not saved, see options" 

Exit Sub 

End If 

gen = spr — result .value 

spr_result .col = 9 

If spr_result .value = M " Then 

MsgBox "No results available" 

Exit Sub 

End If 

ind = spr_result .value 

file_name = home_di rectory & "\" & gen & "\" & ind & " \control" 
Open file_name For Input As #1 

Do While Not E0F{1) ' Loop until end of file. 

Line Input #1, textline ' Read line into variable, 
text = text & textline & vbCrLf 

Loop 

frm_text . Caption = "Control file" 
f rm_text . txt_text = text 
f rm_text . Show 1 , f rm_main 
Close #1 ' Close file. 
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Case 7 



spr_result . col = 8 

spr_result . row = row 

If spr„result .value = " " Then 

MsgBox "Generation not available" 

Exit Sub 

End If 

gen = spr_result .value 
spr_result .col = 9 
ind = spr_result .value 

file_name = home_di rectory & "\" & gen & " \ " & ind 
load„data f rm_graphics . spr_data, f ile_name 

f rm_graphics . Show 
End Select 
End Sub 



Private Sub check_out_Click ( ) 
Dim n_runs As Integer 

nrnns = f rm_options . txt_pop_size * frm_opt ions . txt_generat ions 
frm_main.spr_result .MaxRows = n„runs 
SSTabl.Tab = 2 
stop_run = False 

frm_main.but_stop._run. Enabled = True 
ga_runner True, True 

frm_main,but_stop_run. Enabled = False 
End Sub 

Private Sub continue_run_Click( ) 
stop_run = False 
ga_runner False, False 
End Sub 

Private Sub Edit_token_set_Click ( ) 
Me. Hide 

f rm_tokens « Show 
End Sub 

Private Sub exit_Click{) 
Dim i As Integer 

SaveSetting appname := "NM_GA M , section: =" Startup" , _ 

Key:="N" , setting : =n_files 
For i = 1 To n_files 

SaveSetting appname :="NM_GA" , section: =" Startup" , _ 

Key:="File" & str(i), setting: =start_files (i) 

Next i 

'SaveSetting appname : = " NM__GA" , section: = " Startup" , _ 

Key:="File" & str(l), setting: = "c : \57 0\a-my\ga\57 0b.mdl 

'SaveSetting appname : = " NM_GA " , section: =" Startup" , _ 

Key : = 11 File" Sc str(2), setting: = "c : \570\amy\ga\57 0c .mdl 

End 

End Sub 

Private Sub Form_Load() 
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'ChDir M c:\ga\" 

' cur_model_f ile„name = "c:\ga\gen.mdl" 
'get_model cur_model_f ile_name 
' f rm_tokens . lst„token„group . Listlndex = 0 
' f rm„tokens . lst__token„sets . Listlndex = 0 

End Sub 

Private Sub f ull„grid_Click ( ) 
stop_run = False 
gr id_search 
End Sub 

Private Sub ga__Run_Click ( ) 
Dim n_runs As Integer 

n_runs = f rm_options . txt_pop_size * f rm„options . txt_generations 
frm_main.spr_result .MaxRows = n_runs 
SSTabl.Tab = 2 
stop_run = False 

frm_main.but_stop_run. Enabled = True 
ga_runner True, False 
frra_main.but_stop_run. Enabled = False 
' f rm_inter_results .Hide 

End Sub 

Private Sub open_Click() 

Me.CommonDialogl.DialogTitle = "Open GA model" 
ChDir (home_directory) 

Me.CommonDialogl.InitDir = home_di rectory 
Me. CommonDialogl. filename = "*.mdl" 
Me , CommonDialogl . ShowOpen 

If Me. CommonDialogl. filename = "*.dat" Or Me. CommonDialogl . filename = 
K<1 Or Me. CommonDialogl. filename = "*.mdl" Then 
Exit Sub 
End If 

cur_model_f ile_name = Me. CommonDi a logl . filename 
get_model Me . CommonDialogl . filename 
frm_tokens.lst_token_group. List Index = 0 
frm_tokens .Is t_token_sets . Listlndex = 0 
' get home directory name 
Dim pos As Integer 
pos ~ 1 

While InStr{pos + 1, cur_model_f ile_name, "\") > 0 
pos = InStr(pos + 1, cur_model_f ile_name, " \ " ) 
Wend 

home_di rectory = Lef t (cur_model_f ile_name, pos - 1) 

file_name = Right (cur _model_f ile_name , Len (cur_model_f ile_name) - pos) 

ChDi r ( home_di r ec tory ) 

home_drive = Lef t (home_di rectory , 2) 

ChDr i ve ( home_dr i ve ) 



End Sub 

Private Sub save_as_Click ( ) 
Dim file_name As String 

Me.CommonDialogl.DialogTitle = "Save GA model file" 
Me.CommonDialogl.InitDir = home_directory 
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Me .CommonDialogl . Filter = "*.mdl" 

Me . CommonDialogl . filename = " * . mdl " 

Me . CommonDialogl . ShowSave 

file„name = Me . CommonDialogl . filename 

If Trim(f ile„name) = " " Then Exit Sub 

If file„name = " " Then 

Exit Sub 

Else 

' set home directory 
Dim pos As Integer 
pos = 1 

While InStr(pos + 1, file_name, "\") > 0 
pos = InStr(pos + 1, file_name, "\") 
Wend 

home_directory = Lef t ( f ile„name , pos - 1) 
ChDir (home_di rectory) 
home__drive = Lef t (home_di rectory, 2) 
ChDr i ve ( home_dr i ve ) 

file_name = Right { file_name, Len (f ile_name) - pos) 

ChDr i ve ( home_dr i ve ) 

cur_model_f ile_name = f ile_name 

s a ve_mode 1 ( f i 1 e_name ) 

Dim i As Integer, n As Integer 

For i = 1 To n_files 

If start_f iles (i) = home_drive & " \ " & home_directory & "\" & 
file_name Then 
' remove it 

For n = i To n_files - 1 Step 1 

start_f iles (n) = start_f iles (n + 1) 
Next n 
n_f iles = n_f iles - 1 

start_f iles (n_f iles + 1) = 
Exit For 
End If 
Next i 

If n_files < 4 Then n_files = n_files + 1 
For i = n__files To 2 Step -1 
start_files (i) = start_f iles (i - 1) 
frm„main. files (i) .Caption = start_f iles (i) 
Next i 

start_files(l) = home_drive & w \" & home_directory & "\" & file_name 
frm_main. files (1) .Caption - start_f iles (1) 
End If 
End Sub 

Private Sub Save_Click() 
save_model ( f ile„name) 
End Sub 

Private Sub settings_Click ( ) 

Me . Hide 

set_options 

f rm_options . Show 1 , Me 
End Sub 

Private Sub SSTabl_Click ( PreviousTab As Integer) 
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If SSTabl.Tab = 2 Then 
sort . Enabled = True 
Else 

sort. Enabled = False 
End If 
End Sub 



Tablndex 

Top 

Width 



0 

3240 
975 



End 

End 

Attribute VB_Name = " f rm_debug " 
Attribute VB_Global Name Space = False 
Attribute VB_Creatable = False 
Attribute VB J>redeclaredld = True 
Attribute VB_Exposed = False 
Option Explicit 

Private Sub but„scan_numbs„Click { ) 

scan_tokens 

End Sub 

Private Sub Commandl_Click ( ) 
Me. Hide 
End Sub 
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File frm_edit__token.frm 



VERSION 5.00 

Object = M {F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0' 
Begin VB.Form f rm„edit_token 



"Comdlg3 2 . ocx' 



Caption 

ClientHeight 

ClientLef t 

ClientTop 

ClientWidth 

LinkTopic 

ScaleHeight 

ScaleWidth 



"Edit Token" 

5355 

3900 

3645 

7065 

" Forml " 

5355 

7065 



Begin MSComDlg . CommonDialog CommonDialogl 

Left = 480 

Top = 4680 

_ExtentX = 847 

_ExtentY = 847 

.Version = 327680 
End 

Begin VB.TextBox txt_token 

BeginProperty Font 

Name = "MS 

Size = 12 

Charset = 0 

Weight = 400 

Underline - 0 

Italic = 0 

Strike through = 0 
EndProperty 
Height 

HideSelection = 
Left 



Sans Serif" 



'False 
'False 
'False 



False 



MultiLine = 
ScrollBars = 
Tablndex 

Top = 
Width 
End 

Begin VB .CoinmandButton 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB . CoinmandButton 
Caption - 
Height 
Left 

Tablndex 
Top 
Width 
End 

Begin VB. Label Labell 
Caption = 



'True 
Vertical 



3615 
0 

960 
-1 
2 
2 

480 
5655 



but_cancel 

"Cancel" 

495 

4200 

1 

4320 
1095 

but_done 
" Done " 
495 
2040 
0 

4320 
1095 



"Token 1 
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Height 
Left 

Tablndex 

Top 

Width 



375 
120 
3 



960 
855 



End 

Begin VB.Menu file 



Caption 

Begin VB.Menu import 



File 



Caption = 

End 

Begin VB.Menu export 



" Import 



Caption 

End 

Begin VB.Menu save 



" Export 



Caption 

End 

Begin VB.Menu exit 



"Save and close" 



Caption 

End 



Exit (don't save)" 



End 

End 

Attribute VB_Name = " f rm_edit_token" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 

Private Sub but_done_Click ( ) 

If check_token{ txt_token) = False Then 

Exit Sub 

End If 

Me . Hide 

f rm_tokens . Show 
End Sub 

Private Sub import_Click ( ) 

Dim code As String, text line As String 

Me.CommonDialogl .DialogTitle = "Import token" 

Me . CommonDialogl . filename = " * . txt " 

Me . CommonDialogl . ShowOpen 

If Me.CommonDialogl. filename = "*.txt" Or _ 

Me .CommonDialogl . filename = " " Then 

Exit Sub 
End If 

Open Me . CommonDialogl . filename For Input As #1 
Do While Not EOF(l) ' Loop until end of file. 

Line Input #1, textline ' Read line into variable 
Debug. Print textline ' Print to Debug window, 
code = code & textline & vbCrLf 

Loop 

Close #1 

Me . txt_token = code 
End Sub 



Private Sub export_Click ( ) 
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Dim code As String, textline As String 
Dim new_code As String 

Me.CommonDialogl .DialogTitle = "Export token" 
Me. CommonDialogl . filename = " *.txt" 
Me . CommonDialogl . ShowSave 

If Me.CommonDialogl . filename = "*.txt" Or _ 
Me.CommonDialogl. filename = " " Then 
Exit Sub 

End If 

Open Me.CommonDialogl. filename For Output As 

code = Me.txt_token 
Print #1, code ' Print text to file. 
Close #1 
End Sub 
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File frm_graphics.frm 



VERSION 5.00 

Object = "{B02F3647-766B-11CE-AF28-C3A2FBE76A13}#2.5#0"; " SS32X25 .OCX" 
Object = " {BDC217C8-ED16-llCD-956C-OOO0C04E4C0A}#l.l#O H ; " TABCTL3 2 . OCX" 
Object = "{827E9F53-96A4-11CF-823E-000021570103}#1.0#0" ; ,, GRAPHS32 . OCX" 
Object = «{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#l.l#0 n ; " Comdlg3 2 . ocx" 
Begin VB.Form frm_graphics 

Caption = "Graphics" 

ClientHeight = 883 5 

ClientLeft = 60 

ClientTop = 63 0 

ClientWidth = 10695 

LinkTopic = "Forml" 

SealeHeight = 8835 

ScaleWidth = 10695 

Begin MSComDlg.CommonDialog CommonDialogl 

Left = 3240 

Top = 8400 

_ExtentX = 847 

JSxtentY = 847 

_Version = 327680 

End 

Begin TabDlg.SSTab SSTabl 



Height 


8535 


Left 


120 


Tablndex = 


0 


Top 


120 


Width 


10110 


_ExtentX 


17833 


_ExtentY 


15055 


__Version = 


393216 


TabOrientation = 


1 


Tabs 


1 


Tabs Per Row = 


10 


TabHeight = 


520 


TabCaption(O) = 


"Main" 


TabPicture(O) = 


" f rm_graphics . f rx" : 0000 


Tab ( 0 ) . ControlEnabled= -1 ' True 


Tab(0) .Control (0) 


H Label2 B 


Tab{0) .Control (0) 


.Enabled= 0 'False 


Tab{0) .Control (1) 


" Label 1" 


Tab(0) .Control (1) 


.Enabled= 0 'False 


Tab(0) .Control (2) 


= "spr_data" 


Tab(O) .Control (2) 


. Enabled= 0 ' False 


Tab(0) .Control (3) 


M lst_sort_col" 


Tab(O) .Control (3) 


.Enabled= 0 'False 


Tab(O) .Control (4) 


- " lst_y_axis " 


Tab<0) .Control (4) 


.Enabled^ 0 'False 


Tab(0) .Control (5) 


"lst_x_axis" 


Tab ( 0 ) . Control ( 5 ) 


.Enabled^ 0 'False 


Tab(0) .Control (6) 


"but„histos" 


Tab(0) .Control (6) 


.Enabled= 0 'False 


Tab(0) .Control (7) 


"But_done" 


Tab(0) .Control (7) 


.Enabled^ 0 'False 


Tab(0) .Control (8) 


= "but_make_plot" 


Tab(0) .Control (8) 


.Enabled= 0 'False 
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Width - 495 

_Version = 327680 

_ExtentX = 873 

_ExtentY = 450 

_StockProps = 96 

GraphStyle = 2 

GraphType = 9 

LeftTitleStyle = 1 

RandomData = 0 

SymbolData = "13-13-7-13" 

SymbolSize = 10 

End 

Begin VB.CheckBox chk_ind_sorted_plots 

Caption = "Individual Sorted Plots' 

Height = 255 

Left = 7080 

Tablndex = 15 

Top = 5870 

Width = 2175 
End 

Begin VB.CheckBox chk_ind_y_plots 

Caption = "Individual Y Plots" 

Height = 255 

Left = 3720 

Tablndex = 14 

Top = 5870 

Width = 1815 
End 

Begin VB.CheckBox chk_plot_matrix 

Caption = "Plot matrix" 

Height = 255 

Left = 3960 

Tablndex = 13 

Top = 6720 

Width = 1095 
End 

Begin VB.CheckBox chk_sort_col 

Caption = "Use Sort Item" 

Height = 255 

Left = 7080 

Tablndex = 9 

Top = 3480 

Width = 1455 
End 

Begin VB.CheckBox chk_abs_value 

Caption = "Use Absolute Value" 

Height = 255 

Left = 3720 

Tablndex = 8 

Top - = 6240 

Width = 193 5 
End 

Begin VB.CheckBox chk_unit_line 

Caption = "Unit Line" 

Height = 255 

Left = 600 

Tablndex = 7 
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_Version = 131077 

_ExtentX = 167 4 8 

_ExtentY = 5318 

_StockProps = 64 

BeginProperty Font { 0BE3 5203 -8F9 1- 11CE-9DE3 -00AA004BB851 } 

Name = "MS Sans Serif" 

Size = 8.25 

Charset = 0 

Weight = 700 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 

SpreadDesigner = " f rm_graphics . frx" : 001C 

End 

Begin VB. Label Labell 

Caption = H X axis" 

Height = 255 

Left = 480 

Tablndex = 12 

Top = 33 60 

Width = 1575 

End 

Begin VB. Label Label2 

Caption = tt Y axis" 

Height = 255 

Left = 3720 

Tablndex = 11 

Top = 3360 

Width = 1575 

End 

End 

Begin VB.Menu file 

Caption = "File" 

Begin VB.Menu Close 

Caption = "Close" 

End 

End 

Begin VB.Menu edit 

Caption = "Edit" 

Begin VB.Menu copy 

Caption = "&Copy" 

Shortcut = 

End 

End 

End 

Attribute VB_Name = " f rm_graphics " 
Attribute VB_GlobalName Space = False 
Attribute VB_Creatable = False 
Attribute VB„PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 



Private Sub but_done_Click ( ) 
Unload f rm_graphics 
f rm_main.Show 
End Sub 
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Private Sub but_histos_Click ( ) 
Dim i As Integer 
With frm__histo. lst_histo 
. clear 

For i = 1 To lst_x_axis .ListCount 
.Addltem lst_x_axis . list ( i - 1) 
Next i 
End With 
Me .Hide 
frm_histo.Show 
End Sub 

Private Sub but_make_plot_Click < ) 

Dim i As Integer, n_tabs As Integer, n_plots As Integer 
If lst_x_axis .Listlndex < 0 Then 

MsgBox "Please select one or more x variables" 

Exit Sub 
End If 

If lst_^_axis. Listlndex < 0 Then 

MsgBox "Please select one or more y variables" 

Exit Sub 
End If 

If chk__sort__col. value = 1 And lst_sort_col . Listlndex < 0 Then 

MsgBox "Please select a sort variable" 

Bixit Sub 
End If 

' figure out how may x and y selected 

Dim n_x As Integer, n_y As Integer, xs(l To 20) As Integer, ys(l To 20) 
As Integer 

For i = 0 To lst_x_axis .ListCount - 1 
If lst_x_axis .Selected(i) = True Then 
n_x = n_x + 1 
xs (n_x) = i 
End If 
Next i 

For i = 0 To lst_y_axis . ListCount - 1 
If Is t_y_axis .Selected (i) = True Then 
n__y = n_y + 1 
ys(njy) = i 
End If 
Next i 

n_tabs = SSTabl.Tabs 

n_plots = Graph. count - 1 ' index starts at 0, but we don't use 0 
' single x, single y, single plot 

If n_x = 1 And n_y = 1 And chk_plot_matrix . value = 0 And chk_sort_col = 
0 Then 

n„tabs = n_tabs + 1 

n_plots = n_plots + 1 

SSTabl.Tabs = n_tabs 

SSTabl.Tab = n_tabs - 1 

SSTabl.TabCaption(n_tabs - 1) = Is t_x_axis . list ( Is t_x_axis . Listlndex) 
& "/" & lst_y_axis .list (Is t_y_axis. Listlndex) 
Load Graph (n_plots ) 

make_xy lst_x_axis . Listlndex + 1, lst_y_axis . Listlndex + 1, 
Graph (n_plots) 
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End If 

' single x, several 

If n„x = 1 And n_y > 1 And chk_plot_matrix . value = 0 And chk_sort_col 
0 Then 

' one plot, one x, many y 
make._multiy xs(l), ys, n_y 
End If 

If n_x > 1 And chk_plot_matrix. value = 0 And chk_sort_col = 0 Then 
make_multi_x xs, ys, n_x, n_y 
End If 

' plot matrix, one plot 

If chk_plot_matrix. value = 1 And chk„sort_col = 0 Then 

plot_matrix xs, ys, n_jx, n_y 
End If 

' sorted, one x, one y 

If chk_sort_col = 1 And n_x = 1 And n_^ = 1 Then 
make_sorted_xy xs(l) , ys(l), Me. lst_sort_col .Listlndex 
End If 

End Sub 

Private Sub make_sorted_xy (X As Integer, y As Integer, sort_col As 
Integer) 

' NOTE THAT LISTINDICES START AT 0 

Dim n_subs As Integer, max_obs As Integer, this_point As ^ Integer 
Dim this__sub As Integer, this„graph_jpoint As Integer, this_tab As 
Integer 

Dim n_data As Integer, i As Integer, this_plot As Integer, this_id As 
Integer 

' first need to pass through data, and count max obs per subject 
n_subs = 1 

spr__data . col = sort_col + 1 
spr__data • row = 1 
this_sub - spr_data. value 
For i = 2 To spr„data . MaxRows 
spr_data.row = i 

If spr_data. value <> this_sub Then 
n„subs = n_subs + 1 
this_sub = spr_data. value 
End If 
Next i 
' add a tab 

SSTabl.Tabs = SSTabl.Tabs + 1 
this_tab = SSTabl.Tabs 
SSTabl.Tab = this_tab - 1 
this_plot = Graph. count - 1 
this_plot = this„plot + 1 
Load Graph (this_plot) 
With Graph (this_plot) 

.Visible = True 

.Enabled = True 

.Top = 400 

.Left = 400 

.width = 9200 

.height = 7400 
' how many data 
n_ da t a = sp r _da t a . MaxRows 
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If n_y > n_x Then max_dim = n_y 

width = (SSTabl .width - left_margin * 2) / max_dim - (max_dim - 1) * 
gap 

' 400 FOR TAB ROW 

' need to adjust height for # of rows of tabs 

height = (SSTabl .height - top_margin * 2 - 400) / max_dim - (max_dim 
1) * gap 

n_plots - n_x * n_y + start_plot 

n_data = spr_data .MaxRows 
While this„plot < nj)lots 

this_tab = this_tab + 1 

SSTabl. Tabs = this_tab 

SSTabl. Tab = this_tab - 1 

SSTabl .TabCapt ion (this_tab - 1) = "Matrix" 
For i = 1 To n_x 

If this_plot = n_plots Then Exit For 
For n = 1 To n_y 

If this__plot = n_plots Then Exit For 
this_plot = this__plot + 1 
Load Graph (this_plot) 
With Graph (this_plot) 
.Visible = True 
.BorderStyle = 0 
.Left = left_margin + (n - 1) * width 
.width = width 

.Top = top_margin + (i - 1) * height 
.height = height 

.BottomTitle = lst_x_axis . list (xs ( i) ) 
.LeftTitle = lst__y_axis . list (ys (n) ) 
.Enabled = True 
. NumSets = 1 

.NumPoints = n_data 
For p = 1 To n_data 
Dim junk As String 
spr_data.row = p 
spr_data.col = 0 
' junk = spr_data . text 

' spr_data . col = 1 

' junk = spr_data . text 

spr_data . col = xs ( i ) +1 

.XPos(p) = Val (spr_data.text) 
spr_data.col = ys(n) +1 

.Data(p) = Val (spr_data. text) 
Next p 

.SymbolData = 13 ' solid cirle 
. SymbolSize = 20 + 18 * max_dim 



If Me . chk_trend_line. value = 1 Then 

If op t_line. value = True Then .LineStats = 8 

IE op t_smooth. value = True Then 

. CurveOrder = 2 

.LineStats = 16 

. PatternedLines = 1 

. PatternData = 1 

End If 
End If 

.DrawMode = graphDraw 
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End With 



SSTabl.TabCaption(this_tab - 1) = spr„data. text 
End Sub 

Private Sub make_xy(X As Integer, y As Integer, this_graph As Graph) 
Dim n_data As Integer, i As Integer 

Dim sumx As Double, sumxx As Double, sumy As Double, sumxy As Double, 
sumyy As Double 

'Dim maxx As Single, minx As Single 

Dim slope As Single, intercept As Single, xval As Single, yval As 
Single 

'SSTabl.TabCaption(SSTabl.Tabs - 1) = lst„x_axis . list (X) & "/" & 
lst_y_axis .list (Y) 
With this_.gr aph 

.Visible = True 

.Enabled = True 

.Top = 400 

.Left = 400 

.width = 92 00 

.height = 7400 
' how many data 
n_data = spr_data . MaxRows 

.NumSets = 1 

.NumPoints = n_data 
' maxx = -999999999 
' minx = 999999999 
For i = 1 To n_data 
spr_data.row = i 
spr_data.col = X 

xval = Val(spr_data.text) 

.XPos(i) = xval 

sumx = sumx + xval 

sumxx = sumxx + xval * xval 
' If xval > maxx Then maxx = xval 
' If xval < minx Then minx = xval 

spr_data . col = y 

yval = Val ( spr_data . text ) 

.Data(i) - yval 

sumy = sumy + yval 

sumyy = sumyy + yval * yval 

sumxy = sumxy + yval * xval 
Next i 

.SymbolData = 13 ' solid cirle 

.SymbolSize =30 
spr_data.col - y 
spr_data.row = 0 

.LeftTitle = spr_data . text 
spr_data.col = X 

.BottomTitle = spr_data. text 
add trend line 
If Me. chk_trend_line. value = 1 Then 

If opt_line. value = True Then .LineStats = 8 

If op t_smooth. value = True Then 

.CurveOrder = 2 

.LineStats = 16 

. PatternedLines = 1 

.PatternData = 1 
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End If 
End If 

Dim rsquare As Double 
Dim denom As Double 

denom = Sqr((n_data * sumxx - sumx * sumx) * <n_data * sumyy - sumy * 
suray) ) 

If denom > 0.00000000001 Then 

rsquare = (n_data * sumxy - sumx * sumy) / denom 
Else 

rsquare = 1 
End If 

.BottomTitle = . BottomTitle & " R A 2 = " & Format (rsquare, "0.000") 
.DrawMode = graphDraw 
End With 
End Sub 



Private Sub chk_sort_col_Click ( ) 
If chk_sort_col. value = 1 Then 
lst_sort_col. Enabled = True 
Else 

lst_sort_col .Enabled = False 
End If 
End Sub 

Private Sub chk_trend_line_Click ( ) 
If chk_trend_line. value = 1 Then 
op t_line. Enabled = True 
opt_smooth. Enabled = True 
Else 

op t_line. Enabled = False 
opt_smooth. Enabled = False 
End If 
End Sub 

Private Sub copy_Click() 
MsgBox "Nothing to copy" 
End Sub 
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File frmjiistoirm 



VERSION 5.00 

Object = »{BDC217C8-ED16-11CD-956C-OOOOC04E4COA}#1.1#0" ; " TABCTL3 2 . OCX " 
Object = "{827E9F53-96A4-11CF-823E-000021570103}#1.0#0"; " GRAPHS 3 2 * OCX " 
Begin VB.Form frm_histo 

Caption = "Make Histograms" 

CLientHeight = 9045 
ClientLeft = 60 

ClientTop = 63 0 

ClientWidth = 12120 

LinkTopic = "Forml" 

ScaleHeight = 9 045 

ScaleWidth = 12120 

StartUpPosition = 3 'Windows Default 
Begin VB.TextBox txt__nbins 
Height = 285 

Left = 1320 

Tablndex = 14 

Text = "10" 

Top = 6480 

Width = 855 

End 

Eegin VB.CheckBox chk_autobins 

Caption = "Auto select bins" 

Height = 375 

Left = 480 

Tablndex = 12 

Top = 5880 

Width = 1695 

End 

Begin VB. Frame Frame4 

Height = 1095 

Left = 360 

Tablndex = 9 

Top = 4560 

Width = 1695 

Begin VB . OptionButton opt_lin 

Caption = "Linear scale" 

Height = 255 

Left = 240 

Tablndex = 11 

Top = 240 

Value = -1 'True 

Width = 1215 

End 

Begin VB . OptionButton opt„log 

Caption = "log scale" 

Height = 255 

Left = 240 

Tablndex = 10 

Top = 600 

Width = 1095 

End 

End 

Begin VB.TextBox txt_n_rows 
Height = 405 
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Top 
Width 
_ExtentX 
JExtentY 
_Version 
TabOr i en t a t i on 
Tabs 

TabsPerRow 
TabHeight 
TabPicture (0) 
Tab(0) 
Tab<0) 



0 

9495 
16748 
15478 
327681 
1 
1 
5 

520 

"frnu.histo.frx" :0000 
ControlEnabled= -1 'True 
Control ( 0 ) = " Graph ( 0 ) " 



Control ( 0 ) . Enabled= 
1 



Tab { 0 ) 

Tab(O) .ControlCount= 
Begin Graphs Lib. Graph 

Height 

Index 

Left 

Tablndex = 
Top 

Visible 
Width 

_Version = 
_ExtentX 
_ExtentY 
_StockProps 
BorderStyle = 
GraphType = 
RandomData = 

End 

End 

Begin VB. Label Label2 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB.Menu file 
Caption = 
Begin VB.Menu exit 
Caption 

End 

End 

Begin VB.Menu edit 
Caption = 
Begin VB . Menu copy 
Caption 
- Shortcut 
End 



'False 



Graph 
375 
0 

480 
3 

480 
0 
615 

327680 

1085 

661 

96 

1 

3 

0 



M n bins" 
255 
480 
13 

6480 
735 



False 



"File" 



•Exit" 



Edit' 



1 &Copy" 



End 

End 

Attribute 
Attribute 
Attribute 
Attribute 



VB_Name = " f rm__h i s t o " 
VB_GlobalNameSpace = False 
VB_Cr eatable = False 
VB Predeclaredld = True 
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Attribute VB_Exposed = False 
Private curj>lot As Integer 
Private Sub but_make_plot__Click { ) 

Dim i As Integer, n_tabs As Integer, n_plots As Integer 
If lst_his to . Listlndex < 0 Then 

MsgBox "Please select one or more x variables" 

Exit Sub 
End If 

' figure out how may x and y selected 

Dim n_x As Integer, xs(l To 20) As Integer 

For i = 0 To lst_histo . ListCount - 1 
If lst_histo. Selected (i) = True Then 
n__x = n_x + 1 
xs (n„x) = i 
End If 
Next i 

n__tabs = tab_histo.Tabs 

' only add a tab if this is not the first 

n .plots = Graph. Count - 1 ' index starts at 0, but we don't use 0 

If n_plots = 0 Then n_tabs = 0 
If n_x = 1 Then 

n_tabs = n_tabs + 1 
n_plots = n__plots + 1 
tab_histo .Tabs = n_tabs 
tabJiisto.Tab = n„tabs - 1 

tab_histo.TabCaption(n_tabs - 1) = lst_his to. list <lst_his to . Listlndex) 
Load Graph (n__plots) 
With Graph (n__p lots) 

.Visible = True 

.Enabled = True 

.Top = 400 

.Left = 400 

.width = 9200 

.height = 7400 
' how many data 

n_data = f rm_graphics . spr_data . MaxRows 
.NumSets = 1 
.NumPoints = n_data 
make_histo lst_his to .Listlndex + 1, Graph (n_plots ) 

End With 
End If 

End Sub 

Sub make_histo(X As Integer, this„graph As Graph) 
End Sub 

Private Sub chk_autobins_Click ( ) 
If chk_autobins .value = 0 Then 
txt_nbins . Enabled = True 
Else 

txt_nbins . Enabled = False 
End If 
End Sub 
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Private Sub copy_Click() 

If cur„plot = 0 Then 

MsgBox "Please select a plot" 

Else 

Graph ( cur_plot ) .DrawMode = graphCopy 
End If 
End Sub 

Private Sub exit_Click() 
f rm_graphics . Show 
Me. Hide 
End Sub 

Private Sub FormJTerminate ( ) 
f rm_graphics . Show 
End Sub 

Private Sub Graph__Click{ Index As Integer) 
cur_plot = Index 
End Sub 
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Tab(l) .ControlEnabled= 0 'False 
Tab(l) . Control (0)= " spr_result " 
Tab(l) .ControlCount= 1 
Begin MSChartLib .MSChart MSChartl 

Height = 5655 

Left = 1200 

OleObjectBlob = " f rm_intermediate_results . f rx" :003 8 
Tablndex = 2 

Top = 12 0 

Width = 10335 

End 

Begin FPSpread. vaSpread spr_result 
Height = 589 5 

Left = -74880 

Tablndex = 3 

Top = 12 0 

Width = 11520 

_Version = 131077 

_ExtentX = 2 0320 

_ExtentY = 10398 

_StockProps = 64 

BeginProperty Font {OBE35203-8F91-11CE-9DE3-OOAA004BB851} 

Name = "MS Sans Serif" 

Size = 8.25 

Charset = 0 

Weight = 700 

Underline = 0 ' False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
MaxCols = 14 

ScrollBars = 2 

ScrollBarShowMax= 0 'False 

SpreadDe signer = " f rm_intermediate_results . f rx" : 20C4 
UserResize = 2 

VisibleCols = 500 

VisibleRows = 500 

End 

End 

Begin VB .CommandButton but_stop_run 

Caption = "Stop Run" 

Height = 375 

Left = 9840 

Tablndex = 0 

Top = 6600 

Width = 855 

End 

Begin ComctlLib. ProgressBar pgb_gen 
Height = 210 

Left ^ = 2280 

Tablndex = 5 

Top = 6840 

Width = 5175 

„ExtentX = 912 8 

_ExtentY = 37 0 

_Version = 327682 

Appearance = 1 
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File frm_new_group.frm 

VERSION 5.0 0 

Begin VB.Form f rm„new__group 



"New Token Group" 
3195 
5220 
3735 
4680 
" Forml " 
3195 
4680 
stem 
375 
1440 
4 

720 
1455 



Caption - 
ClientHeight - 
ClientLeft 
ClientTop 
ClientWidth 
LinkTopic = 
ScaleHeight 
ScaleWidth 

Begin VB.TextBox txt 
Height = 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB.TextBox txt_n_ 
Height 
Left 

Tablndex = 
Text 

Top = 
Width 
End 

Begin VB . CommandButton 
Caption - 
Height = 
Left 

Tablndex 
Top 
Width 
End 

Begin VB. CommandButton 
Caption = 
Height 
Left 

Tablndex 
Top 
Width 
End 

Begin VB. Label Label2 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB . Label Labell 

Caption = " # of 

Height = 375 

Left = 240 

Tablndex = 3 

Top = 12 00 



.tokens 
375 
1440 
2 

1200 
1455 

but_cancel 
"Cancel" 
495 
2400 
1 

2400 
1335 

but_done 
"Done" 
495 
720 
0 

2400 
1335 



"Stem 
375 
240 
5 

720 
975 



Tokens 1 



89 



Width = 975 

End 

End 

Attribute VB_Name = " f rm_new_group " 
Attribute VB__Global Name Space = Fals 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 

Private Sub but_cancel_Click ( ) 
Me . txt_n_tokens = -999 
Me.txt_stem = -999 
Me . Hide 

f rm_tokens . Show 
End Sub 

Private Sub but„done_Click ( ) 
Me . Hide 

f rm_tokens . Show 
End Sub 



File frm„options.frm 



VERSION 5.00 

Begin VB.Form frm_options 



Caption 




" Forml " 


ClientHeight 




7485 


ClientLeft 




5265 


Client Top 




3360 


ClientWidth 




8625 


LinkTopic 




" Forml " 


ScaleHeight 




7485 


ScaleWidth 




8625 


Begin VB.CheckBox 


chk_save_l 



Caption = "Save best?" 

Height = 255 

Left = 4800 

Tablndex = 43 

Top = 3960 

Value = 1 'Checked 

Width = 3135 
End 

Begin VB. Frame Frame2 

Caption = "Random seed" 

Height = 1455 

Left = 4680 

Tablndex = 3 8 

Top = 4440 

Width = 3495 

Begin VB.TextBox txt_rnd_seed 

Enabled = 0 'False 

Height = 375 

Left = 2040 

Tablndex = 42 

Text = "1" 

Top = 840 

Width = 615 

End 

Begin VB. OptionButton opt_rnd_user 
Caption = "User Defined" 

Height = 255 

Left = 240 

Tablndex - 41 

Top = 960 

Width = 13 35 

End 

Begin VB . OptionButton opt_rnd__de fault 
Caption = "Use Default" 

Height = 255 

Left = 240 

Tablndex = 40 

Top " = 240 

Value = -1 'True 

Width - 133 5 

End 

Begin VB . OptionButton opt_rnd_clock 
Caption = "Use Clock" 

Height = 255 
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Left = 240 

Tablndex = 39 

Top = 600 

Width = 1335 
End 

End 

Begin VB.CheckBox chk_non_diag__omega 

Caption = "Include ga for non diagonal OMEGA " 

Height = 375 

Left = 4800 

Tablndex = 37 

Top = 3480 

Value = 1 'Checked 

Width = 2895 
End 

Begin VB.TextBox txt_f rame_shif t _j?rob 

Height = 285 

Left = 2760 

Tablndex = 35 

Text = "0.01" 

Top = 1320 

Width = 1455 
End 

Begin VB.CheckBox chk_save_output 

Caption = "Save output file" 

Height = 375 

Left = 4800 

Tablndex = 34 

Top = 3000 

Value = 1 'Checked 

Width = 2775 
End 

Begin VB.CheckBox chk_save_control 

Caption = "Save control file" 

Height = 375 

Left = 4800 

Tablndex = 3 3 

Top = 2640 

Value = 1 'Checked 

Width = 2775 
End 

Begin VB.TextBox txt_generations 

Height = 285 

Left = 2760 

Tablndex = 31 

Text - "20" 

Top = 6120 

Width = 1455 
End 

Begin VB.TextBox txt_succ_crit 

Height = 285 

Left = 2760 

Tablndex = 2 9 

Text = "0.3" 

Top = 5160 

Width - 1455 

End 
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Begin VB.TextBox txt_corr_crit 

"Height = 285 

Left = 2760 

Tablndex = 27 

Text = "50" 

Top = 3720 

Width = 1455 

End 

Begin VB.TextBox txt„lower_limit 

Height = 285 

Left = 2760 

Tablndex = 24 

Text = "0.3" 

Top = 4680 

Width = 1455 
End 

Begin VB.TextBox txt_upper_limit 

Height = 285 

Left = 2760 

Tablndex = 23 

Text = "2" 

Top = 4200 

Width = 1455 
End 

Begin VB.TextBox txt_cov_crit 

Height = 285 

Left = 2760 

Tablndex = 21 

Text = "1000" 

Top = 3240 

Width = 1455 
End 

Begin VB. Frame Framel 

Caption = "NONMEM call" 

Height = 1095 

Left = 4440 

Tablndex = 18 

Top = 3 60 

Width = 2535 

Begin VB .OptionButton opt_dll 

Caption = "DLL (NT only) 

Height = 255 

Left = 120 

Tablndex = 20 

Top = 240 

Width - 1455 
End 

Begin VB. OptionButton opt„exe 

Caption = " EXE {NT or 9? 

Height = 255 

Left = 120 

Tablndex = 19 

Top = 600 

Value = -1 'True 
Width - 1935 

End 

End 
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Begin VB.TextBox txt_cross_over_f req 



Height 
Left 

Tablndex 
Text 
Top 
Width 



285 

2760 

4 

"0.8" 

360 

1455 



End 

Begin VB.TextBox txt„mutation„rate 



Height 
Left 

Tablndex 
Text 
Top 
Width 



285 

2760 

2 

"0.001" 

840 

1455 



Shift Probability" 



End 

Begin VB.CoramandButton but_cancel 

Caption = "Cancel" 

Height = 495 

Left = 4680 

Tablndex = 1 

Top = 6720 

Width = 1095 

End 

Begin VB .CommandButton but_done 

Caption = "Done" 

Height = 495 

Left = 2280 

Tablndex = 0 

Top = 6720 

Width = 1095 
End 

Begin VB. Label Label8 

Caption = 

Height = 
Left 

Tablndex 

Top = 
Width 
End 

Begin VB. Label Labell4 

Caption - 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Labell3 

Caption = "Success Criteria" 

Height = 255 

Left = 240 

Tablndex = 3 0 

Top = 5160 

Width = 2055 

End 

Begin VB. Label Labell2 



"Frame 
255 
240 
36 

1320 
1695 



"Generation limit" 

255 

240 

32 

6120 
1455 
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Caption 

Height 

Left 

Tab Index = 
Top 
Width 
End 

Begin VB. Label Labelll 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label LabellO 
Caption = 
Height = 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Label9 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Label7 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Label6 
Caption - 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Label 5 
Caption = 
Height 
Left 

Tablndex 
Top 
Width 
End 

Begin VB. Label Label 4 
Caption - 



"Penalty for corr > 0.95" 

255 

240 

28 

3720 
2055 



"Lower limit of scaled fitness 

255 

240 

26 

4680 
2055 



"Upper limit of scaled fitness 

255 

240 

25 

4200 
2295 



"Covariance criteria" 

255 

240 

22 

3240 
1335 



"Population size" 

255 

240 

17 

5640 
1095 



"Number of threads' 

255 

4920 

15 

1800 
1695 



"Sigma criteria" 

255 

240 

11 

2760 
1335 



"Omega criteria" 
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Height = 255 

Left = 240 

Tablndex = 9 

Top = 2280 

Width = 1335 

End 

Begin VB. Label Label3 
Caption = 
Height 
Left 

Tablndex 
Top 
Width 
End 

Begin VB. Label Label2 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Labell 
Caption = 
Height 
Left 

Tablndex = 
Top = 
Width 
End 

End 

Attribute VB_Name = " f rm_options " 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 



"Theta Criteria" 
255 
240 
8 

1800 
1695 



"Cross over Frequency" 
255 
240 
5 

240 
1695 



"Mutation rate' 
255 
240 
3 

840 
975 



Private Sub but_cancel_Click ( ) 

Me. Hide 

f rm_main . Show 

End Sub 



Private Sub but_done_Click ( ) 
mutation_rate = Me . txt_mutation_rate 
cross_over_f req = Me . txt_cross_over„f req 
f rame_shif t_prob = Me . txt_f rame__shif t „prob 
theta_crit = Me . txt_theta_crit 
omega_crit = Me . txt_omega_crit 
sigma_crit = Me . txt_sigma_crit 
cov_crit = Me . txt_cov_crit 
success_crit = Me . txt_succ_crit 
generational imit = Me . txt_generations 
lower_f itness_limit = Me . txt_lower_limit 
upper_f itness_limit = Me . txt_upper_limit 
seed_value = Me . txt_rnd_seed . text 

If Me . opt_rnd_clock = True Then seed_type = "clock" 

If Me . op t_rnd_de fault = True Then seed_type = "default" 
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If Me.opt_rnd_user = True Then seed„type = "user" 

corr_crit = Me . txt_corr_crit 

If opt_dll = True Then call_method = "dll" 

If opt_exe = True Then call_method = "exe" 

If chk_save_control = 1 Then 

save_control = True 

Else 

save„control = False 
End If 

If chk_save_best = 1 Then 

save„best = True 

Else 

save_best = False 
End If 

If chk_save_output = 1 Then 

save_output = True 

Else 

save_output = False 
End If 

pop_size = Me. txt__pop_size 
If pop_size Mod 2 <> 0 Then 

MsgBox "Population size must be even number" 
Me. txt_pop_size.SelStart = 0 

Me. txt_pop_size.SelLength = Len (Me . txt_pop_size) 
Me . txt_pop_size . Set Focus 
Exit Sub 
End If 

' need to redimension genome for non diagonal omega 

Dim g2dim As Integer 

If Me . chk_non_diag_omega = 1 Then 

omega_block = True 

Else 

omega__block = False 

End If 
Me. Hide 
f rm_main . Show 
End Sub 

Private Sub chk_non_diag_omega_Click { ) 
If chk_non_diag_omega = True Then 
omega_block = True 
Else 

omega_block = False 
End If 
End Sub 

Private Sub Form_Load{) 

set_options 

End Sub 

Private Sub opt_both_Jimit_Click ( ) 
txt_time . Enabled = True 
txt_generations . Enabled = True 
End Sub 

Private Sub opt_generations_Click ( ) 

txt_time . Enabled = False 
txt_generations. Enabled = True 
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End Sub 

Private Sub opt„time„Click ( ) 

txt„time . Enabled = True 
txt_generations . Enabled = False 
End Sub 



Private Sub opt„rnd_clock_Click ( ) 
seed„type = "clock" 
Me. txt_rnd_seed. Enabled = False 
End Sub 

Private Sub opt_rnd„def ault_Click ( ) 
seed__type = "default" 
Me. txt_rnd_seed. Enabled = False 
End Sub 

Private Sub opt_rnd_user_Click ( ) 

seed_type = "user" 

Me. txt_rnd_seed. Enabled = True 

End Sub 

Private Sub txt_rnd_seed_los t focus ( ) 
On Error GoTo num_error 
seed_value = Me . txt_rnd_seed 

Exit Sub 
num_error : 

MsgBox ("Please enter a number") 
Me . txt_rnd_seed . SetFocus 
Me. txt_rnd_seed,SelStart = 0 

Me . txt_rnd_seed . SelLength = Len (Me . txt_rnd_seed . text ) 

On Error Resume Next 
End Sub 
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Me . Hide 
End Sub 

Private Sub spr„result_Click (ByVal Col As Long, ByVal Row As Long) 
If Col > 4 Then MsgBox "col = " & Col & " row = " & Row 
End Sub 
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File frm sort results.frm 



VERSION 5.00 

Begin VB.Form f rm„sort_results 



Caption = 
ClientHeight 
ClientLeft 
ClientTop 
ClientWidth 
LinkTopic = 
ScaleHeight = 
ScaleWidth 
StartUpPosition = 
Begin VB . CommandButton but_cancel 



"Sort Results" 
3975 
60 
345 
6930 
" Forml " 
3975 
6930 

3 'Windows Default 



Caption 

Height 

Left 

Tablndex 

Top 

Width 



"Cancel" 
495 
3720 
7 

3240 
1095 



End 

Begin VB . CommandButton but_Sort 



Caption 

Height 

Left 

Tablndex 

Top 

Width 



"Sort" 
495 
1920 
6 

3240 
1095 



End 

Begin VB.ListBox lst„third_sort 



Height 
ItemData 
Left 
List 

Tablndex 

Top 

Width 



1230 

" f rm_sort_results . f rx" : 0000 
4800 

" frm_sort_results.frx" :0016 
4 

1320 
1335 



End 

Begin VB.ListBox lst_second_sort 



Height 
ItemData 
Left 
List 

Tablndex 

Top 

Width 



1230 

" f rm_sort_results . f rx" : 004E 
2640 

"frm_sort_results.frx tt :0064 
2 

1320 
1335 



End 

Begin VB.ListBox lst_f irst_sort 

Height = 123 0 

ItemData = " f rm_sort_ 

Left = 600 

List = "frm_sort_ 

Tablndex = 0 

Top = 1320 

Width = 133 5 

End 

Begin VB . Label Label3 



results . f rx" : 009C 



results. frx" :00B2 
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Caption 

Height 

Left 

Tablndex 

Top 

Width 



"Third Sort Variable" 



375 

4800 

5 



720 
1335 



End 



Begin VB. Label Label2 
Caption 
Height 
Left 

Tablndex = 

Top 

Width 



375 

2520 

3 



720 
1815 



"Second Sort Variable" 



End 



Begin VB. Label Labell 
Caption = 
Height 
Left 

Tablndex = 

Top 

Width 



375 
480 
1 



720 
1335 



First Sort Variable" 



End 

End 

Attribute VB_Name = " f rm_sort__results " 
Attribute VB_GlobalName Space = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId - True 
Attribute VB_Exposed = False 

Private Sub but_cancel„Click ( ) 
Me. Hide 
Unload Me 

End Sub 

Private Sub but_Sort_Click { ) 

Dim max_val As Single, max_dig As Integer, f format As String 

max_val = -99999999 

Me. Hide 

' setup_data 

With frm_main. spr_result 

' if using columns 1 or 4, format the data 

If Me.lst_first_sort.ListIndex = 0 Or Me . lst_second_sort . Listlndex = 0 
Or Me. Is t_third_sort. Listlndex = 0 Then col_format (1) 

If Me. lst_first_sort. Listlndex = 3 Or Me. lst_second_sort .Listlndex = 3 
Or Me. lst_third_sort. List Index = 3 Then col„format (4) 

If Me. lst_f irst_sort. Listlndex = 4 Or Me . lst„second_sort .Listlndex - 4 
Or Me. lst_third_sort .Listlndex = 4 Then col_format (8) 

If Me. lst_first_sort. Listlndex - 5 Or Me . lst_second_sort . Listlndex - 5 

Or Me. lst_third_sort. Listlndex = 5 Then col_format (9) 
Dim keyl As Integer, key2 As Integer, key3 As Integer 
If Me. lst_first_sort .Listlndex = -1 Then 
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MsgBox ("Please select one or more sort keys") 
Exit Sub 
End If 

keyl = Me.lst_f irst_sort .Listlndex + 1 

If keyl = 5 Then keyl = 8 

If keyl = 6 Then keyl = 9 

key2 = Me . Is t_second_sort . Listlndex + 1 

If key 2 = 5 Then key 2 = 8 

If key 2 = 6 Then key 2 = 9 

key3 = Me . lst_third_sort . Listlndex + 1 

If key 3 = 5 Then key 3 = 8 

If key3 = 6 Then keyl = 9 

.col = 1 
.Col2 = 9 
.row = 1 

. Row2 = run_number 
.SortKey(l) = keyl 
. SortKeyOrder (1) = 1 
If key 2 > 0 Then 
.SortKey(2) = key2 
.SortKeyOrder (2) = 1 
End If 

If key 3 > 0 Then 
.SortKey(3) = key3 
.SortKeyOrder (3) = 1 
End If 

' we need to format columns 1 and 4 
If keyl = 2 Or keyl = 3 Then . SortKeyOrder (1) = 2 
If key2 = 2 Or key2 = 3 Then . SortKeyOrder (2 ) = 2 
If key3 = 2 Or key3 = 3 Then . SortKeyOrder (3 ) = 2 

.SortBy = 0 

.Action =25 

If Me. Is t_first_sort. Listlndex = 0 Or Me . Is t_second_sort . Listlndex = 0 



Or Me. lst_third_sort. Listlndex = 
If Me. Is t_f irst_sort. Listlndex = 

Or Me. lst__third_sort . Listlndex = 
If Me. Is t_first_sort. Listlndex = 

Or Me. 1 s t_third_s or t. List Index = 
If Me. Is t_first_sort. Listlndex = 



0 Then col_unf ormat (1) 

3 Or Me. lst_second„sort. Listlndex = 3 

3 Then col_unf ormat (4) 

4 Or Me. lst_second_sort .Listlndex = 4 

4 Then col_unf ormat (8) 

5 Or Me. Is t_second_sort .Listlndex = 5 



Or Me. Is t_third_sort. Listlndex = 5 Then col_unf ormat (9) 
End With 
Unload Me 
End Sub 

Sub col_f ormat (coll As Integer) 

Dim this_row As. Integer, max__val As Single, max_dig As Integer 
rnax_val - -99999999 
With f rm__main. spr_result 

.col - coll 
For this_row = 1 To run_number 

. row = this_row 

If Val(.text) > max_val Then max_val = Val(.text) 
Next this__row 
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If max„val <> 0 Then 
max_dig = Log (max__val ) / Log (10) 
Else 

MsgBox ("results cannot be sorted") 
Exit Sub 
End If 

f format = String (max_„dig + 1, "0") & & String (8 - max_dig, 

' and format all the data 

For this_row = 1 To run_number 

.row - this_row 

.text = Format (Val ( .text) , f format) 
Next this_row 
End With 
End Sub 

Sub setup_data() 
Dim this_row As Integer 
With f rm_main . spr_result 
frm_main.SSTabl.Tab = 2 
For this_row = 1 To 40 

.row = this_row 

.col = 1 

.text = (RndO * 4) A 3 
.col = 2 

.text = this_row Mod 2 
.col = 3 

.text = this_row Mod 3 
.col = 4 

.text = (Rnd() * 4) A 3 
.col = 8 

.text = this_row - (this_row Mod 10) 
.col = 9 

.text = this_row Mod 10 
Next this_row 
End With 
End Sub 

Sub col_unformat (col As Integer) 
With f rm_main . spr_result 
.col = col 

For this_row = 1 To run_number 

.row = this_row 

.text = Val (.text) 

Next this_row 

End With 

End Sub 

Sub new_sort{) 

Dim max_val As Single, max_dig As Integer, f format As String 
max__val = -9999999 
Me. Hide 

With f rm_main . spr_result 
For this_row = 1 To 1000 
.col = 1 

.row = this_row 

.text - (Rnd() * 10) A 3 

If Val(.text) > max_val Then max__val = Val(.text) 
.col = 2 

.text = this_row Mod 2 
Next this_row 
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Filefrm text.frm 



VERSION 5.00 

Object = " {F9043C88-F6F2- 
Begin VB . Form f rm_text 



101A-A3C9-08002B2F49FB}#1 . 1#0" ; "Comdlg32 . ocx" 



C^nt" "i on 


— « Forml " 


Client He iaht 


10830 


Cl i f^ntTjef t 

V_. JL JL V • i. J. I-J W J_ V — 


300 




= 630 


ClientWidth 


15075 


LinkTopic 


"Forml" 


ScaleHeight 


10830 


ScaleWidth 


15075 


Begin MSComDlg. 


. CommonDialog 


Left 


2520 


Top 


1680 


__ExtentX 


847 


_ExtentY 


847 



_Version = 327680 

End 

Begin VB.TextBox txt_text 
BeginProperty Font 

Name = "Courier" 

Size = 9.75 

Charset = 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strike through = 0 'False 
EndProperty 

Height = 10815 

Left = 0 

Locked = -1 'True 

MultiLine = -1 'True 

ScrollBars = 3 'Both 

Tablndex = 0 

Top = 0 

Width = 15000 

End 

Begin VB.Menu file 

Caption = "File" 

Begin VB.Menu copy 

Caption = "Copy" 

End 

Begin VB.Menu exit 

Caption = "Exit" 

End 

End 

Begin VB.Menu edit 

Caption = "Edit" 

Begin VB.Menu font 

Caption = "Font" 

End 

End 

End 

Attribute VB_Name = "frm_text" 
Attribute VB_GlobalNameSpace = False 
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Attribute VB_Creatable = False 

Attribute VB_PredeclaredId = True 

Attribute VB_Exposed = False 

Private Sub Commandl_Click( ) 

Me. Hide 

f rm__main . Show 

End Sub 

Private Sub copy_Click{) 
Dim copy„string As String 
If txt_text.SelStart = 0 Then 
MsgBox "No text selected" 
Exit Sub 
End If 

copy„string = Mid { txt_text , txt_text . SelStart , txt_text . SelLength) 
Clipboard. SetText copy_string ' Put text on Clipboard. 
End Sub 

Private Sub exit_Click() 

Me . Hide 

f rm_main . Show 

End Sub 

Private Sub font_Click() 

CommonDialogl .FontBold = txt_text .FontBold 
CommonDialogl.Fontltalic = txt_text .Font Italic 
CommonDialogl . FontName = txt__text . FontName 
CommonDialogl. FontSize = txt_text . FontSize 
CommonDialogl .CancelError = True 
On Error GoTo ErrHandler 
' Set the Flags property 

CommonDialogl . Flags = cdlCFEffects Or cdlCFBoth 
' Display the Font dialog box 
CommonDialogl . ShowFont 

txt_text . Font .Name = CommonDialogl . FontName 
txt_text .Font .Size = CommonDialogl . FontSize 
txt_text .Font .Bold = CommonDialogl . FontBold 
txt_text .Font .Italic - CommonDialogl.Fontltalic 
txt_text . Font . Underline = CommonDialogl . FontUnderline 
txt_text . FontStrikethru = CommonDialogl . FontStrikethru 
txt__text . ForeColor = CommonDialogl . Color 
Exit Sub 
ErrHandler : 

' User pressed the Cancel button 
Exit Sub 

'CommonDialogl. FontBold = txt_text . FontBold 
'CommonDialogl.Fontltalic = txt_text . Fontltalic 
'CommonDialogl. FontName = txt_text . FontName 
'CommonDialogl .FontSize = txt_text . FontSize 
' CommonDialogl . ShowFont 

' txt_text . FontName = CommonDialogl . FontName 
' txt_text. FontBold = CommonDialogl . FontBold 
' txt_text . Fontltalic = CommonDialogl.Fontltalic 
' txt_text . FontSize = CommonDialogl . FontSize 
End Sub 
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Private Sub Form__Terminate ( ) 

Me. Hide 

f rmjna i n . Show 

End Sub 

Private Sub Form_Un load (Cancel As Integer) 

Me. Hide 

f rm_main . Show 

End Sub 



109 



Filefrm tokensirm 



VERSION 5,00 

Begin VB.Form frm__tokens 



Caption = 


" Tokens " 


ClientHeight 


6360 


ClientLeft 


1620 


CiientTop 


1890 


ClientWidth 


11910 


LinkTopic = 


"Forml " 


ScaleHeight = 


6360 


ScaleWidth 


11910 


Begin VB.ListBox 1 


s t_token_gr oup 


Height 


3375 


Left 


9240 


Tablndex 


10 


Top 


960 


Width 


2175 


End 





Begin VB .CommandButton but_remove_group 

Caption = "Remove Token Group" 

Height = 495 

Left = 10200 

Tablndex = 9 

Top = 4680 

Width = 1575 
End 

Begin VB.CommandButton but_new_group 

Caption = "New Token Group" 

Height = 495 

Left = 8640 

Tablndex = 8 

Top = 4680 

Width = 1455 
End 

Begin VB . ComraandButton but_new_set 

Caption = "New Token set" 

Height = 495 

Left = 4200 

Tablndex = 5 

Top = 4680 

Width = 1455 
End 

Begin VB . CommandButton but_remove_set 

Caption = "Remove Token set" 

Height = 495 

Left = 6240 

Tablndex = 3 

Top = 4680 

Width = 1575 
End 

Begin VB.ListBox lst_token„sets 

Height = 3375 

Left = 3240 

Tablndex = 2 

Top = 960 

Width = 5295 
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Underline = 0 



'False 
' False 
' False 



Italic = 0 



Strikethrough = 0 
EndProperty 



Height = 3 75 

Left = 1080 

Tablndex = 6 



Top = 0 



Width = 133 5 



End 

Begin VB. Label lbl_token_name 



Height = 375 

Left = 4560 

Tablndex = 4 



Top = 480 

Width = 1935 



End 

End 

Attribute VB_Name = ■ f rm_tokens" 
Attribute VB_GlobalName Space = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Dim curr_group As String 

Dim currjposition As Integer ' which token group 

Dim curr_token As Integer ' which token 

Dim curr_token_set As Integer ' which token set 

Private Sub but_done„Click ( ) 

Me . Hide 

f rm_main . Show 

End Sub 

Private Sub but_new_group_Click ( ) 
Me . Hide 

f rm_new_group . txt_n_tokens = " " 

f rm__new_group . txt_n_ tokens = " 1 " 

f rm_new_gr oup . Show modal : =1 , owne r f o rm : =Me 

' n_tokens is set to -999 by cancel 

If f rm_new__group . txt_n_tokens = "-999" And f rm_new_gr oup . txt_js tern = 
999" Then 
Exit Sub 
End If 

n_token_groups = n__token_groups + 1 

Dim curr_stem As String 

curr_stem = frm_new„gr oup . txt_s tern 

token„col lection (n_token_groups ). stem = curr_stem 

token_collection (n__token_groups) .n__tokens = f rm_new_group . txt_n_tokens 

1 st__token_gr oup . Addl tern curr^stem 

Me . lbl_token_name = curr_stem 

curr_group = cur r_s tern 

curr_position = n_token_groups 

lst„token_group . List Index = curr_position - 1 

' token_collection (cur reposition) - n_token_sets - 0 

token_col lection (curr_position) . get_token__set lst_token_sets 

lst_tokens . clear 

End Sub 
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Private Sub but_new__set__Click ( ) 
If curr_position > 0 Then 

token_collection (curr_position) . add_token_set lst__token_sets 
curr_token_set = Is t_token_sets . ListCount 

token_collection(curr_position) .get_tokens lst_tokens, curr_token_set 
lst_token_sets . Listlndex = lst_token_sets . ListCount - 1 
End If 
End Sub 

Private Sub but_remove_group_Click( ) 
Dim this_group As Integer 
If Is t_token__gro up . Listlndex > -1 Then 
n_token_groups = n_token_groups - 1 

For this_group = lst_token_group .Listlndex + 1 To n_groups - 1 
Set token_collection(this_group) = token_collection ( this_group + 1) 

Next this_group 

Set token_col lection (n_groups) = Nothing 

lst_token_group . Removeltem ( Is t_token_group - Listlndex) 

token — collection (curr_position) . get_token_set lst_token_sets 

If lst_token__group. ListCount > 0 Then 

1 s t _t o ken_gr o up . List Index = 0 

Else 

lst_token_group. List Index = -1 
lst_token_sets . clear 
End If 
curr_position = 1 

token_collection(curr_position) . get_token__set lst_token_sets 
If lst__token_sets .ListCount > 0 Then 
Is t_token_sets .Listlndex = 0 
Else 

lst_token_sets .Listlndex = -1 

lst_tokens .clear 

End If 
End If 
End Sub 

Private Sub but_remove_set_Click ( ) 
If lst_token_sets .Listlndex > -1 Then 
token_collection (curr_position) ,remove_token„set 
( Is t_token_sets ♦ Listlndex + 1) 

token_collection(curr_position) . get_token_set lst_token_sets 
curr_position = lst_token_group .Listlndex + 1 
token_collection(curr__position) . get_token_set lst__token_sets 
If lst_token_sets ♦ ListCount > 0 Then 
Is t_token_sets . Listlndex = 0 
Else 

lst_jtoken_sets . Listlndex = -1 
lst_tokens . clear 
End If 

curr_token_set = lst_token_sets . Lis tlndex + 1 

token_collection (curr_position) . get_tokens lst_tokens , curr_token_set 
End If 
End Sub 
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Private Sub Form_Load ( ) 
curr_position = 1 
curr_token„set = 1 
cur r„ token = 1 
End Sub 

Private Sub lst_token_group_Click ( ) 

curr_group = Is t__token_group . list ( Is t__token_group . List Index) 

curr_position = lst_token_group . List Index + 1 

token_col lection (curr_position) . get_token_set lst_token_sets 

curr_token__set = 1 

If lst_token_sets .ListCount > 0 Then 

Is t_token_sets . List Index = curr_token_set - 1 

End If 

token_collection(curr_position) . get_tokens lst_tokens, curr_token_set 
End Sub 

Private Sub lst_token_sets_Click { ) 
curr_token_set = lst_token_sets . Listlndex + 1 

token_collection(curr_position) .get_tokens lst„_tokens, curr_token_set 
End Sub 

Private Sub lst_tokens_dblClick ( ) 
curr_token = lst_tokens .Listlndex + 1 
f rm_edi t_t oken . t x t_t oken = 

token_collection(curr_position) . get_token_with_lines (curr_token_set / 

curr__token) 

Me. Hide 

f rm_edit_jtoken. Show modal :=1, owner fo rm : =Me 
' first change the token in the token set 

token_collection(curr_position) . set_token curr__token_set , curr_token, 
f rm_edit_token . txt_token 
1 update the tokenn list 

t;oken_collection(curr_position) .get_tokens lst__tokens , curr_token_set 
' update token set list 

token_collection(curr_position) . get_token_.se t lst_token_sets 
End Sub 
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